64-BitBrainstorm_2026/AMSS-NCKU
8
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[TEST]UPSTREAM: Pick some source changes from 48080d0a97

Browse Source 
* Sync new folder structure
This commit is contained in:
ianchb
2026-04-23 20:55:40 +08:00
parent c185f99ee3
commit 17109fde9b
211 changed files with 189504 additions and 189280 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4026
AMSS_NCKU_source/Null_Evolve/NullEvol.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

225
AMSS_NCKU_source/Null_Evolve/NullEvol.h Normal file
View File

@@ -0,0 +1,225 @@
#ifndef NULLEVOL_H
#define NULLEVOL_H
#ifdef fortran1
#define f_setup_dyad setup_dyad
#define f_eth_derivs eth_derivs
#define f_eth_dderivs eth_dderivs
#define f_fill_symmetric_boundarybuffer fill_symmetric_boundarybuffer
#define f_fill_symmetric_boundarybuffer2 fill_symmetric_boundarybuffer2
#define f_calculate_K calculate_k
#define f_NullEvol_beta nullevol_beta
#define f_NullEvol_Q nullevol_q
#define f_NullEvol_U nullevol_u
#define f_NullEvol_W nullevol_w
#define f_NullEvol_Theta nullevol_theta
#define f_NullEvol_Theta_givenx nullevol_theta_givenx
#define f_Eq_Theta eq_theta
#define f_Eq_Theta_2 eq_theta_2
#define f_NullEvol_g01 nullevol_g01
#define f_NullEvol_pg0A nullevol_pg0a
#define f_NullEvol_Theta2 nullevol_theta2
#define f_NullEvol_Thetag00 nullevol_thetag00
#endif
#ifdef fortran2
#define f_setup_dyad SETUP_DYAD
#define f_eth_derivs ETH_DERIVS
#define f_eth_dderivs ETH_DDERIVS
#define f_fill_symmetric_boundarybuffer FILL_SYMMETRIC_BOUNDARYBUFFER
#define f_fill_symmetric_boundarybuffer2 FILL_SYMMETRIC_BOUNDARYBUFFER2
#define f_calculate_K CALCULATE_K
#define f_NullEvol_beta NULLEVOL_BETA
#define f_NullEvol_Q NULLEVOL_Q
#define f_NullEvol_U NULLEVOL_U
#define f_NullEvol_W NULLEVOL_W
#define f_NullEvol_Theta NULLEVOL_THETA
#define f_NullEvol_Theta_givenx NULLEVOL_THETA_GIVENX
#define f_Eq_Theta EQ_THETA
#define f_Eq_Theta_2 EQ_THETA_2
#define f_NullEvol_g01 NULLEVOL_G01
#define f_NullEvol_pg0A NULLEVOL_PG0A
#define f_NullEvol_Theta2 NULLEVOL_THETA2
#define f_NullEvol_Thetag00 NULLEVOL_THETAG00
#endif
#ifdef fortran3
#define f_setup_dyad setup_dyad_
#define f_eth_derivs eth_derivs_
#define f_eth_dderivs eth_dderivs_
#define f_fill_symmetric_boundarybuffer fill_symmetric_boundarybuffer_
#define f_fill_symmetric_boundarybuffer2 fill_symmetric_boundarybuffer2_
#define f_calculate_K calculate_k_
#define f_NullEvol_beta nullevol_beta_
#define f_NullEvol_Q nullevol_q_
#define f_NullEvol_U nullevol_u_
#define f_NullEvol_W nullevol_w_
#define f_NullEvol_Theta nullevol_theta_
#define f_NullEvol_Theta_givenx nullevol_theta_givenx_
#define f_Eq_Theta eq_theta_
#define f_Eq_Theta_2 eq_theta_2_
#define f_NullEvol_g01 nullevol_g01_
#define f_NullEvol_pg0A nullevol_pg0a_
#define f_NullEvol_Theta2 nullevol_theta2_
#define f_NullEvol_Thetag00 nullevol_thetag00_
#endif
extern "C"
{
void f_setup_dyad(int *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *,
int &, double &);
}
extern "C"
{
void f_eth_derivs(int *, double *, double *,
double *, double *,
double *, double *,
int &, int &,
double *, double *, double *, double *, double *, double *);
}
extern "C"
{
void f_eth_dderivs(int *, double *, double *,
double *, double *,
double *, double *,
int &, int &, int &,
double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *);
}
extern "C"
{
void f_fill_symmetric_boundarybuffer(int *, double *, double *, double *,
double &, double &,
double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, int &, int &, int &);
}
extern "C"
{
void f_fill_symmetric_boundarybuffer2(int *, double *, double *, double *,
double &, double &,
double *, int &, int &, double *);
}
extern "C"
{
void f_calculate_K(int *, double *, double *, double *,
double *, double *,
double *, double *, double *, double *);
}
extern "C"
{
int f_NullEvol_beta(int *, double *, double *, double *,
double *, double *, double *, double *, double *);
}
extern "C"
{
int f_NullEvol_Q(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double *, double *, double *);
}
extern "C"
{
int f_NullEvol_U(int *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *,
double *, double *, double &);
}
extern "C"
{
int f_NullEvol_W(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *, double &,
double *, double *, double *, double *, double *, double *, double *, double *, double *, double *);
}
extern "C"
{
int f_NullEvol_Theta(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double &,
double *, double *, double *, double *, double *, double *, double *, double *, double *, double *);
}
extern "C"
{
int f_NullEvol_Theta_givenx(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double &,
double *, double *, double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double &, int &);
}
extern "C"
{
int f_Eq_Theta(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double &,
double *, double *, double *, double *, double *, double *, double *, double *, double *, double *);
}
extern "C"
{
int f_Eq_Theta_2(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double &,
double *, double *, double *, double *, double *, double *, double *, double *, double *, double *,
double &, int &);
}
extern "C"
{
int f_NullEvol_g01(int *, double *, double *, double *,
double *, double *, double *, double *,
double &);
}
extern "C"
{
int f_NullEvol_pg0A(int *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double &);
}
extern "C"
{
int f_NullEvol_Theta2(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *,
double &);
}
extern "C"
{
int f_NullEvol_Thetag00(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *,
double &);
}
#endif /* NULLEVOL_H */

4449
AMSS_NCKU_source/Null_Evolve/NullEvol2.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

688
AMSS_NCKU_source/Null_Evolve/NullNews.f90 Normal file
View File

@@ -0,0 +1,688 @@
#include "macrodef.fh"
!------------------------------------------------------------------------------
function omega_rhs(ex,crho,sigma,R,omega,RU,IU,omegarhs, &
quR1,quR2,quI1,quI2,gR,gI) result(gont)
implicit none
integer,intent(in) :: ex(3)
real*8,intent(in),dimension(ex(1))::crho
real*8,intent(in),dimension(ex(2))::sigma
real*8,intent(in),dimension(ex(3))::R
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: omega,RU,IU
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: omegarhs
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: quR1,quR2,quI1,quI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: gR,gI
! gont = 0: success; gont = 1: something wrong
integer::gont
double complex, dimension(ex(1),ex(2),ex(3)) :: comega,eth_omega,U,eth_Ub
real*8 :: dR
integer :: k
!!! sanity check
dR = sum(omega)+sum(RU)+sum(IU)
if(dR.ne.dR) then
if(sum(omega).ne.sum(omega))write(*,*)"NullEvol_beta: find NaN in omega"
if(sum(RU).ne.sum(RU))write(*,*)"NullEvol_beta: find NaN in RU"
if(sum(IU).ne.sum(IU))write(*,*)"NullEvol_beta: find NaN in IU"
gont = 1
return
endif
comega = dcmplx(omega,0.d0)
U = dcmplx(RU,IU)
do k=1,ex(3)
call derivs_eth(ex(1:2),crho,sigma,comega(:,:,k),eth_omega(:,:,k),0,1, &
quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k))
call derivs_eth(ex(1:2),crho,sigma,U(:,:,k),eth_Ub(:,:,k),1,-1, &
quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k),gR(:,:,k),gI(:,:,k))
enddo
!!! The term * e^{-2beta} has been added so as to be consistent with HPN. Nigel
!omega_u = - dble(eth_omega * conjg(U) + 0.5d0 * omega * eth_Ub * exp(-2*beta))
!!! - update .. I thought this may have been wrong so I removed the
!!! e^{-2beta} for testing. Yosef
! omegarhs = - dreal(eth_omega * dconjg(U) + 0.5d0 * omega * eth_Ub)
omegarhs = - 0.5d0*dreal(eth_Ub)
gont = 0
return
end function omega_rhs
!---------------------------------------------------------------------------------------------------------
subroutine drive_null_news(ex,crho,sigma,R,RJ,IJ,RU,IU,RTheta,ITheta,omega,beta, &
qlR1,qlR2,qlI1,qlI2, &
quR1,quR2,quI1,quI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,RNews,INews,Rmin,sst)
implicit none
integer,intent(in) :: ex(3),sst
real*8,intent(in) :: Rmin
real*8,intent(in),dimension(ex(1))::crho
real*8,intent(in),dimension(ex(2))::sigma
real*8,intent(in),dimension(ex(3))::R
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RTheta,ITheta,omega,beta
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: RNews,INews
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: qlR1,qlR2,qlI1,qlI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: quR1,quR2,quI1,quI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: gR,gI
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dquR1,dquR2,dquI1,dquI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: bdquR1,bdquR2,bdquI1,bdquI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dgR,dgI,bdgR,bdgI
integer :: i,j,k
double complex, dimension(ex(1),ex(2),ex(3)) :: CJ,U,J_u,J_l,J_l_u,News
#if 0
call get_fake_Ju(ex,crho,sigma,R,RTheta,ITheta, &
quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst)
#endif
CJ = dcmplx(RJ,IJ)
U = dcmplx(RU,IU)
J_u = dcmplx(RTheta,ITheta)
do j=1,ex(2)
do i=1,ex(1)
call cderivs_x(ex(3),R,CJ(i,j,:),J_l(i,j,:))
call cderivs_x(ex(3),R,J_u(i,j,:),J_l_u(i,j,:))
J_l(i,j,:) = -J_l(i,j,:)*Rmin*R**2
J_l_u(i,j,:) = -J_l_u(i,j,:)*Rmin*R**2
enddo
enddo
#if 0
if(sst == 0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then
call get_exact_Jul(ex,crho,sigma,R,RNews,INews, &
quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst)
write(*,*) J_u(ex(1)/2,ex(2)/2,ex(3)-1),J_u(ex(1)/2,ex(2)/2,ex(3))
write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3))
write(*,*) J_l_u(ex(1)/2,ex(2)/2,ex(3))
write(*,*)dcmplx(RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)))/J_l_u(ex(1)/2,ex(2)/2,ex(3))
endif
stop
#endif
do k=1,ex(3)
call get_null_news(ex(1:2),crho,sigma,CJ(:,:,k),U(:,:,k),J_u(:,:,k),J_l(:,:,k),J_l_u(:,:,k),omega(:,:,k),beta(:,:,k), &
qlR1(:,:,k),qlR2(:,:,k),qlI1(:,:,k),qlI2(:,:,k), &
quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k), &
gR(:,:,k),gI(:,:,k), &
dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), &
bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), &
dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k),News(:,:,k))
enddo
RNews = dreal(News)
INews = dimag(News)
#if 0
if(sst ==0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then
call get_exact_eth2omega(ex,crho,sigma,R,RNews,INews, &
quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst)
write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3))
endif
stop
#endif
#if 0
! check orthornormality
RNews = RJ
INews = IJ
RNews = 0.5d0*dreal(J_l_u)
INews = 0.5d0*dimag(J_l_u)
#endif
call six2spher(ex,crho,sigma,R,RNews,INews,2,Rmin,sst)
return
end subroutine drive_null_news
!---------------------------------------------------------------------------------------------------------
subroutine drive_null_news_diff(ex,crho,sigma,R,RJ,IJ,RU,IU,RTheta,ITheta,omega,beta, &
qlR1,qlR2,qlI1,qlI2, &
quR1,quR2,quI1,quI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,RNews,INews,Rmin,sst,Time)
implicit none
integer,intent(in) :: ex(3),sst
real*8,intent(in) :: Rmin,Time
real*8,intent(in),dimension(ex(1))::crho
real*8,intent(in),dimension(ex(2))::sigma
real*8,intent(in),dimension(ex(3))::R
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: RJ,IJ,RU,IU,RTheta,ITheta,omega,beta
real*8, dimension(ex(1),ex(2),ex(3)),intent(out) :: RNews,INews
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: qlR1,qlR2,qlI1,qlI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: quR1,quR2,quI1,quI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: gR,gI
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dquR1,dquR2,dquI1,dquI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: bdquR1,bdquR2,bdquI1,bdquI2
real*8, dimension(ex(1),ex(2),ex(3)),intent(in) :: dgR,dgI,bdgR,bdgI
integer :: i,j,k
double complex, dimension(ex(1),ex(2),ex(3)) :: CJ,U,J_u,J_l,J_l_u,News
#if 0
call get_fake_Ju(ex,crho,sigma,R,RTheta,ITheta, &
quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst)
#endif
CJ = dcmplx(RJ,IJ)
U = dcmplx(RU,IU)
J_u = dcmplx(RTheta,ITheta)
do j=1,ex(2)
do i=1,ex(1)
call cderivs_x(ex(3),R,CJ(i,j,:),J_l(i,j,:))
call cderivs_x(ex(3),R,J_u(i,j,:),J_l_u(i,j,:))
J_l(i,j,:) = -J_l(i,j,:)*Rmin*R**2
J_l_u(i,j,:) = -J_l_u(i,j,:)*Rmin*R**2
enddo
enddo
#if 0
if(sst == 0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then
call get_exact_Jul(ex,crho,sigma,R,RNews,INews, &
quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst)
write(*,*) J_u(ex(1)/2,ex(2)/2,ex(3)-1),J_u(ex(1)/2,ex(2)/2,ex(3))
write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3))
write(*,*) J_l_u(ex(1)/2,ex(2)/2,ex(3))
write(*,*)dcmplx(RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3)))/J_l_u(ex(1)/2,ex(2)/2,ex(3))
endif
stop
#endif
do k=1,ex(3)
call get_null_news(ex(1:2),crho,sigma,CJ(:,:,k),U(:,:,k),J_u(:,:,k),J_l(:,:,k),J_l_u(:,:,k),omega(:,:,k),beta(:,:,k), &
qlR1(:,:,k),qlR2(:,:,k),qlI1(:,:,k),qlI2(:,:,k), &
quR1(:,:,k),quR2(:,:,k),quI1(:,:,k),quI2(:,:,k), &
gR(:,:,k),gI(:,:,k), &
dquR1(:,:,k),dquR2(:,:,k),dquI1(:,:,k),dquI2(:,:,k), &
bdquR1(:,:,k),bdquR2(:,:,k),bdquI1(:,:,k),bdquI2(:,:,k), &
dgR(:,:,k),dgI(:,:,k),bdgR(:,:,k),bdgI(:,:,k),News(:,:,k))
enddo
call get_exact_news(ex,crho,sigma,R,RNews,INews,sst,Rmin,Time)
RNews = dreal(News) - Rnews
INews = dimag(News) - INews
!this part is nonsence
RNews(:,:,1:ex(3)-1) = 0.d0
INews(:,:,1:ex(3)-1) = 0.d0
#if 0
if(sst ==0 .and. crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then
call get_exact_eth2omega(ex,crho,sigma,R,RNews,INews, &
quR1,quR2,quI1,quI2,qlR1,qlR2,qlI1,qlI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,dacos(-1.d0)/2,Rmin,sst)
write(*,*) RNews(ex(1)/2,ex(2)/2,ex(3)),INews(ex(1)/2,ex(2)/2,ex(3))
endif
stop
#endif
#if 0
! check orthornormality
RNews = RJ
INews = IJ
RNews = 0.5d0*dreal(J_l_u)
INews = 0.5d0*dimag(J_l_u)
#endif
call six2spher(ex,crho,sigma,R,RNews,INews,2,Rmin,sst)
return
end subroutine drive_null_news_diff
!------------------------------------------------------------------------------------------------------------
subroutine get_null_news(ex,crho,sigma,J,U,J_u,J_l,J_l_u,omega,beta, &
qlR1,qlR2,qlI1,qlI2, &
quR1,quR2,quI1,quI2, &
gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI,News)
implicit none
integer,intent(in) :: ex(2)
real*8,intent(in),dimension(ex(1))::crho
real*8,intent(in),dimension(ex(2))::sigma
double complex,dimension(ex(1),ex(2)),intent(in) :: J,U
double complex,dimension(ex(1),ex(2)),intent(in) :: J_u,J_l,J_l_u
real*8,dimension(ex(1),ex(2)),intent(in) :: omega,beta
real*8,dimension(ex(1),ex(2)),intent(in) :: qlR1,qlR2,qlI1,qlI2
real*8,dimension(ex(1),ex(2)),intent(in) :: quR1,quR2,quI1,quI2
real*8,dimension(ex(1),ex(2)),intent(in) :: gR,gI
real*8,dimension(ex(1),ex(2)),intent(in) :: dquR1,dquR2,dquI1,dquI2
real*8,dimension(ex(1),ex(2)),intent(in) :: bdquR1,bdquR2,bdquI1,bdquI2
real*8,dimension(ex(1),ex(2)),intent(in) :: dgR,dgI,bdgR,bdgI
double complex,dimension(ex(1),ex(2)),intent(out) :: News
! local variables
real*8,dimension(ex(1),ex(2)) :: K,K_u,K_l,K_l_u
real*8,dimension(ex(1),ex(2)) :: a
double complex,dimension(ex(1),ex(2)) :: Comega,Cbeta
double complex,dimension(ex(1),ex(2)) :: Jb,Ub
double complex,dimension(ex(1),ex(2)) :: eth_a,eth2_a,eth_ethb_a
double complex,dimension(ex(1),ex(2)) :: s1,s2,s3,s4,s5
double complex,dimension(ex(1),ex(2)) :: eth_U,ethb_U,eth_J,ethb_J
double complex,dimension(ex(1),ex(2)) :: eth_J_l,ethb_J_l,eth_K_l,eth_K
double complex,dimension(ex(1),ex(2)) :: eth_omega,eth_beta
double complex,dimension(ex(1),ex(2)) :: eth2_omega,eth2_beta
double complex,dimension(ex(1),ex(2)) :: eth_ethb_omega,eth_ethb_beta
Comega = dcmplx(omega,0.d0)
Cbeta = dcmplx(beta,0.d0)
call derivs_eth(ex,crho,sigma,Comega,eth_omega,0,1,quR1,quR2,quI1,quI2,gR,gI)
call derivs_eth(ex,crho,sigma,Cbeta,eth_beta,0,1,quR1,quR2,quI1,quI2,gR,gI)
call dderivs_eth(ex,crho,sigma,Comega,eth2_omega,0,1,1, &
quR1,quR2,quI1,quI2,gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI)
call dderivs_eth(ex,crho,sigma,Cbeta,eth2_beta,0,1,1, &
quR1,quR2,quI1,quI2,gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI)
call dderivs_eth(ex,crho,sigma,Comega,eth_ethb_omega,0,-1,1, &
quR1,quR2,quI1,quI2,gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI)
call dderivs_eth(ex,crho,sigma,Cbeta,eth_ethb_beta,0,-1,1, &
quR1,quR2,quI1,quI2,gR,gI, &
dquR1,dquR2,dquI1,dquI2, &
bdquR1,bdquR2,bdquI1,bdquI2, &
dgR,dgI,bdgR,bdgI)
call derivs_eth(ex,crho,sigma,U,eth_U,1,1,quR1,quR2,quI1,quI2,gR,gI)
call derivs_eth(ex,crho,sigma,U,ethb_U,1,-1,quR1,quR2,quI1,quI2,gR,gI)
call derivs_eth(ex,crho,sigma,J,eth_J,2,1,quR1,quR2,quI1,quI2,gR,gI)
call derivs_eth(ex,crho,sigma,J,ethb_J,2,-1,quR1,quR2,quI1,quI2,gR,gI)
call derivs_eth(ex,crho,sigma,J_l,eth_J_l,2,1,quR1,quR2,quI1,quI2,gR,gI)
call derivs_eth(ex,crho,sigma,J_l,ethb_J_l,2,-1,quR1,quR2,quI1,quI2,gR,gI)
Jb = dconjg(J)
Ub = dconjg(U)
K = dsqrt(1.0d0 + cdabs(J)**2)
! temp storage
Comega=dcmplx(K,0.d0)
call derivs_eth(ex,crho,sigma,Comega,eth_K,0,1,quR1,quR2,quI1,quI2,gR,gI)
K_u = dreal( J_u * Jb ) / K
K_l = dreal( J_l * Jb ) / K
! temp storage
Comega=dcmplx(K_l,0.d0)
call derivs_eth(ex,crho,sigma,Comega,eth_K_l,0,1,quR1,quR2,quI1,quI2,gR,gI)
K_l_u = dreal( J_u * dconjg(J_l) + J_l_u * Jb )/ K - K_l * K_u / K
a = omega * dexp(2.0d0 * beta)
eth_a = dexp(2.0d0 * beta) * ( eth_omega + 2.0d0 * omega * eth_beta )
eth2_a = dexp(2.0d0 * beta) * ( 4.0d0 * eth_beta * eth_omega &
+ 4.0d0 * omega * eth_beta**2 &
+ eth2_omega + 2.0d0 * omega * eth2_beta )
eth_ethb_a = dexp(2.0d0 * beta) * ( 4.0d0 * dreal(eth_beta * dconjg(eth_omega)) &
+ 4.0d0 * omega * eth_beta * dconjg(eth_beta) &
+ eth_ethb_omega + 2.0d0 * omega * eth_ethb_beta )
s1 = ( -2.0d0 * K_l_u * J * (K + 1.0d0) + J_l_u * (K + 1.0d0)**2 &
+ dconjg(J_l_u) * J**2 ) / (K + 1.0d0)
s2 = 0.5d0 / ( K + 1.0d0) * ( &
(K + 1.0d0)* (eth_J_l *Ub * (K+1.0d0) - 2.0d0* eth_K_l * J *Ub ) &
+ eth_U * (K+1.0d0)* ( -2.0d0 * J * dconjg(J_l) + K_l * 2.0d0 * (K+1.0d0) ) &
+ dconjg(ethb_U) * (K+1.0d0) * ( -2.0d0* J * K_l + J_l * 2.0d0 * (K+1.0d0) ) &
+ ethb_J_l * U * (K+1.0d0)**2 - dconjg(eth_K_l) * 2.0d0 * U * J * (K+1.0d0) &
+ ethb_U * 2.0d0 * J * ( J * dconjg(J_l) - (K+1.0d0) * K_l) &
+ J**2 * ( U * dconjg(eth_J_l) + dconjg(ethb_J_l * U) ) &
+ J * 2.0d0 * dconjg(eth_U) * ( J * K_l - J_l * (K+1.0d0) ) )
s3 = ( J_l * (K + 1.0d0)**2 -2.0d0 * K_l * J * (K + 1.0d0) &
+ dconjg(J_l) * J**2) / (K + 1.0d0)
s4 = 0.5d0 / ( K + 1.0d0) * ( eth_a * eth_omega * (K + 1.0d0)**2 &
- (K+1.0d0) * J * 2.0d0* dreal( eth_a * dconjg(eth_omega) ) &
+ J**2 * dconjg(eth_a * eth_omega) )
s5 = 0.25d0 / ( K + 1.0d0) * ( 2.0d0 * eth2_a * (K+1.0d0)**2 &
+ 2.0d0 * J**2 * dconjg(eth2_a) &
- 4.0d0 * eth_ethb_a * J * (K+1.0d0) &
+ Jb * eth_a * eth_J* (K+1.0d0)**2 &
+ J * eth_a * dconjg(ethb_J) * (K+1.0d0)**2 &
- eth_a * eth_K * 2.0d0 * (K+1.0d0) * ( J*Jb + (K+1.0d0) ) &
+ eth_a * ethb_J * (K+1.0d0) * ( -J*Jb + (K+1.0d0) ) &
- J**2 * eth_a * dconjg(eth_J) * K &
+ J**2 * Jb * 2.0d0* eth_a * dconjg(eth_K) &
- dconjg(eth_a) * eth_J * (K+1.0d0) * ( J*Jb + K+1.0d0 ) &
- dconjg(ethb_J) * dconjg(eth_a) * J**2 * ( K + 2.0d0) &
+ J * 2.0d0 * (K+1.0d0)**2 * eth_K * dconjg(eth_a) &
+ J**2 * Jb * ethb_J * dconjg(eth_a) &
+ J**3 * dconjg(eth_a * eth_J) &
- 2.0d0* J**2 *K*dconjg(eth_K * eth_a) )
! News = 0.25d0 * ( s1 + s2 + 0.5d0 * dble(ethb_U) * s3 &
! - 4.0d0 * s4 / omega**2 + 2.0d0 * s5 / omega ) / ( omega**2 * exp(2.0d0 * beta) )
! change sign of s3 to compensate for a bug in Eqs. 30, 37, and 38 of
! HPN
#if 1
News = 0.25d0 * ( s1 + s2 - 0.5d0 * dreal(ethb_U) * s3 &
- 4.0d0 * s4 / omega**2 + 2.0d0 * s5 / omega ) / ( omega**2 * dexp(2.0d0 * beta) )
#else
#if 0
if(crho(1) < -dacos(-1.d0)/4 .and. sigma(1) < -dacos(-1.d0)/4)then
write(*,*) eth2_omega(ex(1)/2,ex(2)/2)
endif
#endif
News = 0.5d0*J_l_u+eth2_beta+0.5d0*eth2_omega ! if given omega error is about 6e-9
! News = 0.5d0*J_l_u+eth2_beta-1.5d0*J ! error is about 6e-9
#endif
return
end subroutine get_null_news
!--------------------------------------------------------------------------------------------------
! change spin weighted function from 6 patches to spherical coordinate
subroutine six2spher(ex,crho,sigma,R,RU,IU,spin,Rmin,sst)
implicit none
!~~~~~~% Input parameters:
integer,intent(in) :: ex(3),sst,spin
real*8,intent(in) :: Rmin
double precision,intent(in),dimension(ex(1))::crho
double precision,intent(in),dimension(ex(2))::sigma
double precision,intent(in),dimension(ex(3))::R
real*8,dimension(ex(1),ex(2),ex(3)),intent(inout) :: RU,IU
integer :: i,j,k
real*8 ::x,y,z,hgr,gt,gp,tgrho,tgsigma,tc,ts,rf
double complex :: II,swtf,ff
II = dcmplx(0.d0,1.d0)
hgr = 1.d0
do i=1,ex(1)
do j=1,ex(2)
do k=1,ex(3)
! hgr = R(k)*Rmin/(1.d0-R(k)) R is not invovled indeed, to avoid NaN, we set
! it to 1 above
tgrho = dtan(crho(i))
tgsigma = dtan(sigma(j))
tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0)
ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0)
select case (sst)
case (0)
z = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (1)
z = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (2)
x = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (3)
x = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (4)
y = hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case (5)
y = -hgr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case default
write(*,*) "six2spher: not recognized sst = ",sst
return
end select
gt = dacos(z/hgr)
gp = datan2(y,x)
swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j))
if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf)
select case (sst)
case (0,1)
swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2)
case (2,3)
swtf = II*swtf*dsin(gt)
case (4,5)
swtf = -II*swtf*dsin(gt)
end select
ff=dcmplx(RU(i,j,k),IU(i,j,k))/swtf**spin
RU(i,j,k) = dreal(ff)
IU(i,j,k) = dimag(ff)
enddo
enddo
enddo
return
end subroutine six2spher
!-------------------------------------------------------------
! Linear wave given in Eq.(27) of CQG 22, 2393 (2005)
!-------------------------------------------------------------
subroutine get_exact_omega(ex,crho,sigma,R,omega,sst,Rmin,T)
implicit none
! argument variables
integer, intent(in ):: ex(1:3),sst
real*8,intent(in) :: Rmin,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
real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::omega
integer :: i,j,k
real*8 ::x,y,z,gr,gt,gp,tgrho,tgsigma,tc,ts
double complex :: Yslm,II,Jr
double complex :: beta0,C1,C2
integer :: nu,m
double complex :: swtf,ff
call initial_null_paramter(beta0,C1,C2,nu,m)
II = dcmplx(0.d0,1.d0)
do i=1,ex(1)
do j=1,ex(2)
do k=1,ex(3)
!fake global coordinate is enough here
gr = 1.d0
tgrho = dtan(crho(i))
tgsigma = dtan(sigma(j))
tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0)
ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0)
select case (sst)
case (0)
z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (1)
z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (2)
x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (3)
x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (4)
y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case (5)
y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case default
write(*,*) "get_exact_omega: not recognized sst = ",sst
return
end select
gt = dacos(z/gr)
gp = datan2(y,x)
swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j))
if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf)
select case (sst)
case (0,1)
swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2)
case (2,3)
swtf = II*swtf*dsin(gt)
case (4,5)
swtf = -II*swtf*dsin(gt)
end select
gr = (1.d0-R(k))/R(k)/Rmin
Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1+C1/4.d0*gr-C2/1.2d1*gr**3
gr = dreal(Jr*cdexp(II*nu*T))
Jr = Yslm(0,2,m,gt,gp)
omega(i,j,k) = 1.d0-2.d0*(2+1)/2.d0*gr*dreal(Jr)
enddo
enddo
enddo
return
end subroutine get_exact_omega
!-------------------------------------------------------------
! Linear wave given in Eq.(16) of CQG 24S327
!-------------------------------------------------------------
subroutine get_exact_news(ex,crho,sigma,R,RNews,INews,sst,Rmin,Time)
implicit none
! argument variables
integer, intent(in ):: ex(1:3),sst
real*8,intent(in) :: Rmin,Time
double precision,intent(in),dimension(ex(1))::crho
double precision,intent(in),dimension(ex(2))::sigma
double precision,intent(in),dimension(ex(3))::R
real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::RNews,INews
integer :: i,j,k
real*8 ::x,y,z,gr,gt,gp,tgrho,tgsigma,tc,ts
double complex :: Yslm,II,Jr
double complex :: beta0,C1,C2
integer :: nu,m
double complex :: swtf,ff
call initial_null_paramter(beta0,C1,C2,nu,m)
II = dcmplx(0.d0,1.d0)
do i=1,ex(1)
do j=1,ex(2)
do k=1,ex(3)
!fake global coordinate is enough here
gr = 1.d0
tgrho = dtan(crho(i))
tgsigma = dtan(sigma(j))
tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0)
ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0)
select case (sst)
case (0)
z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (1)
z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (2)
x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (3)
x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (4)
y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case (5)
y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case default
write(*,*) "get_initial_null: not recognized sst = ",sst
return
end select
gt = dacos(z/gr)
gp = datan2(y,x)
swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma(j))
if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf)
select case (sst)
case (0,1)
swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2)
case (2,3)
swtf = II*swtf*dsin(gt)
case (4,5)
swtf = -II*swtf*dsin(gt)
end select
Jr = II*nu**3*C2/dsqrt(2.4d1)
gr = dreal(Jr)
Jr = Yslm(2,2,m,gt,gp)
ff = gr*Jr*swtf**2
RNews(i,j,k) = dreal(ff)
INews(i,j,k) = dimag(ff)
enddo
enddo
enddo
return
end subroutine get_exact_news

106
AMSS_NCKU_source/Null_Evolve/NullNews.h Normal file
View File

@@ -0,0 +1,106 @@
#ifndef NULLNEWS_H
#define NULLNEWS_H
#ifdef fortran1
#define f_drive_null_news drive_null_news
#define f_get_null_news2 get_null_news2
#define f_drive_null_news_diff drive_null_news_diff
#define f_omega_rhs omega_rhs
#define f_get_exact_omega get_exact_omega
#define f_get_omega_and_dtomega_pre get_omega_and_dtomega_pre
#define f_get_omega_and_dtomega_LN get_omega_and_dtomega_ln
#define f_get_dtomega get_dtomega
#endif
#ifdef fortran2
#define f_drive_null_news DRIVE_NULL_NEWS
#define f_get_null_news2 GET_NULL_NEWS2
#define f_drive_null_news_diff DRIVE_NULL_NEWS_DIFF
#define f_omega_rhs OMEGA_RHS
#define f_get_exact_omega GET_EXACT_OMEGA
#define f_get_omega_and_dtomega_pre GET_OMEGA_AND_DTOMEGA_PRE
#define f_get_omega_and_dtomega_LN GET_OMEGA_AND_DTOMEGA_LN
#define f_get_dtomega GET_DTOMEGA
#endif
#ifdef fortran3
#define f_drive_null_news drive_null_news_
#define f_get_null_news2 get_null_news2_
#define f_drive_null_news_diff drive_null_news_diff_
#define f_omega_rhs omega_rhs_
#define f_get_exact_omega get_exact_omega_
#define f_get_omega_and_dtomega_pre get_omega_and_dtomega_pre_
#define f_get_omega_and_dtomega_LN get_omega_and_dtomega_ln_
#define f_get_dtomega get_dtomega_
#endif
extern "C"
{
void f_drive_null_news(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double &, int &);
}
extern "C"
{
void f_drive_null_news_diff(int *, double *, double *, double *,
double *, double *, double *, double *, double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double &, int &, double &);
}
extern "C"
{
void f_omega_rhs(int *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *, double *, double *,
double *, double *);
}
extern "C"
{
void f_get_exact_omega(int *, double *, double *, double *,
double *,
int &, double &, double &);
}
extern "C"
{
void f_get_null_news2(int *, double *, double *, double *,
double *, double *,
double *, double *, double *, double *,
double *, double *, double *,
double *, double *, double *,
double *, double *, double &, int &);
}
extern "C"
{
void f_get_omega_and_dtomega_pre(int *, double *, double *, double *,
double *, double *, double *,
double *, double *, double &);
}
extern "C"
{
void f_get_dtomega(int *, double *, double *, double *,
double *, double *, double *,
double *, double *, double &);
}
extern "C"
{
void f_get_omega_and_dtomega_LN(double &, int *, double *, double *, double *,
double *, double *, double &, int &);
}
#endif /* NULLNEWS_H */

588
AMSS_NCKU_source/Null_Evolve/NullNews2.f90 Normal file
View File

@@ -0,0 +1,588 @@
#include "macrodef.fh"
!------------------------------------------------------------------------------
! input R is X indeed
! input g00 is g00/r^2 indeed
! input g0A is g0A/r^2 indeed
! input gAB is gAB/r^2 indeed
! output Gamma is Gamma of omega^2 g_{munu}/r^2 at r = infinity or to say X = 1
! ** in coordinate (u,X,x,y) **
subroutine get_christoffel(Rmin,g00,g01,g02,g03, &
g22,g23,g33, &
dgt22,dgt23,dgt33,&
dg22,dg23,dg33,&
dgx02,dgx03,dgx22,dgx23,dgx33,&
dgy02,dgy03,dgy22,dgy23,dgy33,&
omega,dtomega,dxomega,dyomega,&
Gamuxx,Gamuxy,Gamuyy, &
Gamrxx,Gamrxy,Gamryy, &
Gamxxx,Gamxxy,Gamxyy, &
Gamyxx,Gamyxy,Gamyyy)
implicit none
real*8,intent(in)::Rmin
real*8,intent(in)::g00,g01,g02,g03,g22,g23,g33
real*8,intent(in)::dgt22,dgt23,dgt33
real*8,intent(in)::dg22,dg23,dg33
real*8,intent(in)::dgx02,dgx03,dgx22,dgx23,dgx33
real*8,intent(in)::dgy02,dgy03,dgy22,dgy23,dgy33
real*8,intent(in) :: omega,dtomega,dxomega,dyomega
real*8,intent(out) :: Gamuxx,Gamuxy,Gamuyy
real*8,intent(out) :: Gamrxx,Gamrxy,Gamryy
real*8,intent(out) :: Gamxxx,Gamxxy,Gamxyy
real*8,intent(out) :: Gamyxx,Gamyxy,Gamyyy
real*8 :: t1;
real*8 :: t10;
real*8 :: t11;
real*8 :: t117;
real*8 :: t12;
real*8 :: t121;
real*8 :: t138;
real*8 :: t142;
real*8 :: t147;
real*8 :: t18;
real*8 :: t184;
real*8 :: t190;
real*8 :: t194;
real*8 :: t198;
real*8 :: t2;
real*8 :: t204;
real*8 :: t206;
real*8 :: t208;
real*8 :: t214;
real*8 :: t216;
real*8 :: t220;
real*8 :: t222;
real*8 :: t227;
real*8 :: t230;
real*8 :: t233;
real*8 :: t239;
real*8 :: t24;
real*8 :: t241;
real*8 :: t242;
real*8 :: t244;
real*8 :: t249;
real*8 :: t25;
real*8 :: t252;
real*8 :: t28;
real*8 :: t29;
real*8 :: t32;
real*8 :: t37;
real*8 :: t47;
real*8 :: t53;
real*8 :: t54;
real*8 :: t58;
real*8 :: t64;
real*8 :: t65;
real*8 :: t66;
real*8 :: t68;
real*8 :: t71;
real*8 :: t72;
real*8 :: t73;
real*8 :: t75;
real*8 :: t76;
real*8 :: t77;
real*8 :: t80;
real*8 :: t82;
real*8 :: t84;
real*8 :: t85;
real*8 :: t88;
real*8 :: t9;
real*8 :: t91;
t1 = 1/g01;
t2 = Rmin*t1;
t9 = 1/omega;
t10 = Rmin*t9;
t11 = g01*omega;
t12 = g22*g03;
t18 = g23*g02;
t24 = g01*g22;
t25 = t18*dyomega;
t28 = g23*g03;
t29 = t28*dxomega;
t32 = g33*g02;
t37 = g22*g33;
t47 = g23*g23;
t53 = g22*g22;
t54 = g01*t53;
t58 = t47*dtomega;
t64 = Rmin*dg22;
t65 = t64*omega;
t66 = t37*g00;
t68 = t18*g03;
t71 = omega*g22;
t72 = g03*g03;
t73 = t71*t72;
t75 = omega*g33;
t76 = g02*g02;
t77 = t75*t76;
t80 = omega*t47*g00;
t82 = 2.0*t24*t32*dxomega-2.0*t11*t47*dgx02+t11*t47*dgt22-2.0*t54*g33*dtomega &
+2.0*t24*t58+2.0*t54*g03*dyomega+t65*t66+2.0*t65*t68-t64*t73-t64*t77-t64*t80;
t84 = g01*g01;
t85 = 1/t84;
t88 = 1/(t37-t47);
t91 = Rmin*dg23;
t117 = g01*g33;
t121 = g01*t47;
t138 = t91*omega;
t142 = -t11*t12*dgx33+t11*t18*dgx33+2.0*t117*t18*dxomega-2.0*t121*g03*dxomega &
-2.0*t121*g02*dyomega+t11*t47*dgt23-t11*t47*dgx03-t11*t47*dgy02+2.0*g01*t47*g23*dtomega+t138*t66+2.0*t138*t68;
t147 = Rmin*dg33;
t184 = g33*g33;
t190 = g01*t184;
t194 = t147*omega;
t198 = -2.0*t117*t25-2.0*t117*t29-t11*t12*dgy33+t11*t18*dgy33-2.0*t11*t47*dgy03+t11*t47*dgt33-2.0*t24*t184*dtomega &
+2.0*t117*t58+2.0*t190*g02*dxomega+t194*t66+2.0*t194*t68;
t204 = g02*dg22*Rmin;
t206 = omega*g23;
t208 = g03*dg22*Rmin;
t214 = 2.0*t24*g33*dxomega;
t216 = t11*g23*dgy22;
t220 = g23*dyomega;
t222 = 2.0*t24*t220;
t227 = t1*t88;
t230 = g02*dg23*Rmin;
t233 = g03*dg23*Rmin;
t239 = 2.0*t24*g33*dyomega;
t241 = t11*g23*dgx33;
t242 = g23*dxomega;
t244 = 2.0*t117*t242;
t249 = g02*dg33*Rmin;
t252 = g03*dg33*Rmin;
Gamuxx = -t2*dg22/2.0;
Gamuxy = -t2*dg23/2.0;
Gamuyy = -t2*dg33/2.0;
Gamrxx = t10*(-2.0*t11*t12*dgx23+t11*t12*dgy22+2.0*t11*t18*dgx23-t11*t18*dgy22+t11*t28*dgx22-t11*t32*dgx22 &
-t11*t37*dgt22+2.0*t11*t37*dgx02-2.0*t24*t25-2.0*t24*t29+t82)*t85*t88/2.0;
Gamrxy = t10*(-t91*t73-t91*t77-t91*t80-2.0*t24*g33*g23*dtomega-t11*t37*dgt23+t11*t37*dgx03+t11*t37*dgy02 &
-t11*t32*dgy22+t11*t28*dgy22+2.0*t24*t28*dyomega+t142)*t85*t88/2.0;
Gamryy = t10*(-t147*t73-t147*t77-t147*t80+2.0*t11*t37*dgy03-t11*t37*dgt33+2.0*t24*g33*g03*dyomega &
-2.0*t11*t32*dgy23+t11*t32*dgx33+2.0*t11*t28*dgy23-t11*t28*dgx33+t198)*t85*t88/2.0;
Gamxxx = t9*(-2.0*t11*g23*dgx23+t11*g33*dgx22+t75*t204-4.0*t121*dxomega-t206*t208+t214+t216+t222)*t227/2.0;
Gamxxy = t9*(t11*g33*dgy22+t75*t230-t206*t233+t239-t241-t244)*t227/2.0;
Gamxyy = t9*(-t11*g23*dgy33-t11*g33*dgx33+2.0*t11*g33*dgy23+t75*t249-2.0*t190*dxomega+2.0*t117*t220-t206*t252)*t227/2.0;
Gamyxx = -t9*(-2.0*t11*g22*dgx23+t11*g22*dgy22+t11*g23*dgx22-2.0*t24*t242+2.0*t54*dyomega-t71*t208+t206*t204)*t227/2.0;
Gamyxy = -(-t11*g22*dgx33-t71*t233+t206*t230-t214+t216+t222)*t9*t227/2.0;
Gamyyy = t9*(t11*g22*dgy33-2.0*t11*g23*dgy23+t71*t252-4.0*t121*dyomega-t206*t249+t239+t241+t244)*t227/2.0;
return
end subroutine get_christoffel
!!----------------------------------------------------------------------------------------
subroutine get_News(crho,sigma,&
dxxomega,dxyomega,dyyomega,&
omega,dtomega,dxomega,dyomega,&
Gamuxx,Gamuxy,Gamuyy, &
Gamrxx,Gamrxy,Gamryy, &
Gamxxx,Gamxxy,Gamxyy, &
Gamyxx,Gamyxy,Gamyyy,RNew,INew,sst)
implicit none
integer,intent(in) :: sst
real*8,intent(in)::crho,sigma
real*8,intent(in) :: dxxomega,dxyomega,dyyomega
real*8,intent(in) :: omega,dtomega,dxomega,dyomega
real*8,intent(in) :: Gamuxx,Gamuxy,Gamuyy
real*8,intent(in) :: Gamrxx,Gamrxy,Gamryy
real*8,intent(in) :: Gamxxx,Gamxxy,Gamxyy
real*8,intent(in) :: Gamyxx,Gamyxy,Gamyyy
real*8,intent(out) :: RNew,INew
real*8 :: cs,cr,ss,sr,tc,ts
real*8 :: WWxx,WWxy,WWyy
real*8 :: Rmmxx,Rmmxy,Rmmyy
real*8 :: Immxx,Immxy,Immyy
real*8 :: gr,tgrho,tgsigma,x,y,z,gt,gp
double complex :: swtf,II
write(*,*) Gamrxx,Gamrxy,Gamryy
WWxx = (dxxomega-(Gamuxx*dtomega+Gamxxx*dxomega+Gamyxx*dyomega))/omega/2
WWxy = (dxyomega-(Gamuxy*dtomega+Gamxxy*dxomega+Gamyxy*dyomega))/omega/2
WWyy = (dyyomega-(Gamuyy*dtomega+Gamxyy*dxomega+Gamyyy*dyomega))/omega/2
cs = dcos(sigma)
cr = dcos(crho)
ss = dsin(sigma)
sr = dsin(crho)
tc = dsqrt((1-sr*ss)/2)
ts = dsqrt((1+sr*ss)/2)
Rmmxx = 4*tc*tc*ts*ts*(ts*ts-tc*tc)/cs/cs
Rmmxy = 4*tc*tc*ts*ts*(ts*ts+tc*tc)/cs/cr
Rmmyy = 4*tc*tc*ts*ts*(ts*ts-tc*tc)/cr/cr
Immxx = 8*tc*tc*ts*ts*ts*tc/cs/cs
Immxy = 0
Immyy = -8*tc*tc*ts*ts*ts*tc/cr/cr
if(sst==1 .or. sst==3 .or. sst==4)then
Immxx = -Immxx
Immxy = -Immxy
Immyy = -Immyy
endif
RNew = Rmmxx*WWxx+2*Rmmxy*WWxy+Rmmyy*WWyy
INew = Immxx*WWxx+2*Immxy*WWxy+Immyy*WWyy
!! change to tetrad theta phi
!fake global coordinate is enough here
II = dcmplx(0.d0,1.d0)
gr = 1.d0
tgrho = dtan(crho)
tgsigma = dtan(sigma)
select case (sst)
case (0)
z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (1)
z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (2)
x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (3)
x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (4)
y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case (5)
y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case default
write(*,*) "get_News: not recognized sst = ",sst
return
end select
gt = dacos(z/gr)
gp = datan2(y,x)
swtf = 2.d0*tc*ts*(ts+II*tc)/dcos(sigma)
if(sst==1 .or. sst==3 .or. sst==4) swtf = dconjg(swtf)
select case (sst)
case (0,1)
swtf = swtf/(dcos(gp)+II*dcos(gt)*dsin(gp))*(dcos(gt)**2+dsin(gt)**2*dcos(gp)**2)
case (2,3)
swtf = II*swtf*dsin(gt)
case (4,5)
swtf = -II*swtf*dsin(gt)
end select
swtf = (RNew+II*INew)/swtf**2
RNew = dreal(swtf)
INew = dimag(swtf)
return
end subroutine get_News
!------------------------------------------------------------------------------------------------------------
subroutine get_null_news2(ex,crho,sigma,R,omega,dtomega, &
g00,g01,g02,g03,g22,g23,g33, &
dtg22,dtg23,dtg33, &
RNews,INews,Rmin,sst)
implicit none
integer,intent(in) :: ex(3),sst
real*8,intent(in) :: Rmin
real*8,intent(in),dimension(ex(1))::crho
real*8,intent(in),dimension(ex(2))::sigma
real*8,intent(in),dimension(ex(3))::R
real*8,dimension(ex(1),ex(2),ex(3)),intent(in ) :: omega,dtomega
real*8,dimension(ex(1),ex(2),ex(3)),intent(in ) :: g00,g01,g02,g03,g22,g23,g33
real*8,dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtg22,dtg23,dtg33
real*8,dimension(ex(1),ex(2),ex(3)),intent(out) :: RNews,INews
real*8 :: Gamuxx,Gamuxy,Gamuyy
real*8 :: Gamrxx,Gamrxy,Gamryy
real*8 :: Gamxxx,Gamxxy,Gamxyy
real*8 :: Gamyxx,Gamyxy,Gamyyy
real*8 :: dg22,dg23,dg33
real*8 :: dgx22,dgx23,dgx33
real*8 :: dgx02,dgx03
real*8 :: dgy22,dgy23,dgy33
real*8 :: dgy02,dgy03
real*8 :: dxomega,dyomega
real*8 :: dxxomega,dxyomega,dyyomega
integer :: i,j,k
k = ex(3)
do i=1,ex(1)
do j=1,ex(2)
call rderivs_x_point(ex(3),R,g22(i,j,:),dg22,k)
call rderivs_x_point(ex(3),R,g23(i,j,:),dg23,k)
call rderivs_x_point(ex(3),R,g33(i,j,:),dg33,k)
call rderivs_x_point(ex(1),crho,g02(:,j,k),dgx02,i)
call rderivs_x_point(ex(1),crho,g03(:,j,k),dgx03,i)
call rderivs_x_point(ex(1),crho,g22(:,j,k),dgx22,i)
call rderivs_x_point(ex(1),crho,g23(:,j,k),dgx23,i)
call rderivs_x_point(ex(1),crho,g33(:,j,k),dgx33,i)
call rderivs_x_point(ex(1),crho,omega(:,j,k),dxomega,i)
call rderivs_x_point(ex(2),sigma,g02(i,:,k),dgy02,j)
call rderivs_x_point(ex(2),sigma,g03(i,:,k),dgy03,j)
call rderivs_x_point(ex(2),sigma,g22(i,:,k),dgy22,j)
call rderivs_x_point(ex(2),sigma,g23(i,:,k),dgy23,j)
call rderivs_x_point(ex(2),sigma,g33(i,:,k),dgy33,j)
call rderivs_x_point(ex(2),sigma,omega(i,:,k),dyomega,j)
call get_christoffel(Rmin,g00(i,j,k),g01(i,j,k),g02(i,j,k),g03(i,j,k), &
g22(i,j,k),g23(i,j,k),g33(i,j,k), &
dtg22(i,j,k),dtg23(i,j,k),dtg33(i,j,k),&
dg22,dg23,dg33,&
dgx02,dgx03,dgx22,dgx23,dgx33,&
dgy02,dgy03,dgy22,dgy23,dgy33,&
omega(i,j,k),dtomega(i,j,k),dxomega,dyomega,&
Gamuxx,Gamuxy,Gamuyy, &
Gamrxx,Gamrxy,Gamryy, &
Gamxxx,Gamxxy,Gamxyy, &
Gamyxx,Gamyxy,Gamyyy)
call rdderivs_x_point(ex(1),crho,omega(:,j,k),dxxomega,i)
call rdderivs_x_point(ex(2),crho,omega(i,:,k),dyyomega,j)
call rdderivs_xy_point(ex(1),ex(2),crho,sigma,omega(:,:,k),dxyomega,i,j)
call get_News(crho(i),sigma(j),&
dxxomega,dxyomega,dyyomega,&
omega(i,j,k),dtomega(i,j,k),dxomega,dyomega,&
Gamuxx,Gamuxy,Gamuyy, &
Gamrxx,Gamrxy,Gamryy, &
Gamxxx,Gamxxy,Gamxyy, &
Gamyxx,Gamyxy,Gamyyy,RNews(i,j,k),INews(i,j,k),sst)
enddo
enddo
return
end subroutine get_null_news2
!!------------------------------------------------------------------------------------------------------------
!! input g_AB and Theta_AB are divided by r^2 indeed
!! input g_00 is also divided by r^2 indeed
! the output g00 is K
subroutine get_omega_and_dtomega_pre(ex,crho,sigma,X,g22,g23,g33, &
omega,dtomega, Rmin)
implicit none
! argument variables
integer, intent(in ):: ex(1:3)
real*8,intent(in) :: Rmin
double precision,intent(in),dimension(ex(1))::crho
double precision,intent(in),dimension(ex(2))::sigma
double precision,intent(in),dimension(ex(3))::X
real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::g22,g23,g33
real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::omega,dtomega
double precision,dimension(ex(3))::R
real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK
real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33
real*8 :: fr,fs,frr,fss,frs,covf
integer :: i,j,k
real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam
call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam)
R = X*Rmin/(1-X)
det = g22*g33-g23*g23
gup22 = g33/det
gup23 = -g23/det
gup33 = g22/det
do i=1,ex(1)
do j=1,ex(2)
do k=1,ex(3)
sr = dsin(crho(i))
ss = dsin(sigma(j))
cr = dcos(crho(i))
cs = dcos(sigma(j))
sr2 = sr*sr
ss2 = ss*ss
cr2 = cr*cr
cs2 = cs*cs
tg22 = 1-sr2*ss2
tg22 = 1/tg22/tg22
tg23 = -sr*cr*ss*cs*tg22
tg33 = cr2*tg22
tg22 = cs2*tg22
! ghat/(g/r^4) indeed
det(i,j,k) = (tg22*tg33-tg23*tg23)/det(i,j,k)
enddo
enddo
enddo
omega = dsqrt(det)
k = ex(3)
do i=1,ex(1)
do j=1,ex(2)
call rderivs_x_point(ex(1),crho,det(:,j,k),fr,i)
call rderivs_x_point(ex(2),sigma,det(i,:,k),fs,j)
call rdderivs_xy_point(ex(1),ex(2),crho,sigma,det(:,:,k),frs,i,j)
call rdderivs_x_point(ex(1),crho,det(:,j,k),frr,i)
call rdderivs_x_point(ex(2),sigma,det(i,:,k),fss,j)
call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf)
KK(i,j,k) = dsqrt(det(i,j,k))*(1-0.25*covf/R(k)**2)
enddo
enddo
dtomega = KK
return
end subroutine get_omega_and_dtomega_pre
!------------------------------------------------------------------------------------------------------
subroutine get_dtomega(ex,crho,sigma,X,g22,g23,g33, &
omega,dtomega, Rmin)
implicit none
! argument variables
integer, intent(in ):: ex(1:3)
real*8,intent(in) :: Rmin
double precision,intent(in),dimension(ex(1))::crho
double precision,intent(in),dimension(ex(2))::sigma
double precision,intent(in),dimension(ex(3))::X
real*8,dimension(ex(1),ex(2),ex(3)),intent(in)::omega,g22,g23,g33
real*8,dimension(ex(1),ex(2),ex(3)),intent(inout)::dtomega
double precision,dimension(ex(3))::R
real*8,dimension(ex(1),ex(2),ex(3))::det,gup22,gup23,gup33,KK
real*8 :: sr,ss,cr,cs,sr2,ss2,cr2,cs2,tg22,tg23,tg33
real*8 :: fr,fs,frr,fss,frs,covf
integer :: i,j,k
real*8 :: m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam
call get_RT_parameters(m0,Pp0,Pm0,ap,am,bp,bm,cp,cm,gam)
KK = dtomega
k = ex(3)
do i=1,ex(1)
do j=1,ex(2)
call rderivs_x_point(ex(1),crho,KK(:,j,k),fr,i)
call rderivs_x_point(ex(2),sigma,KK(i,:,k),fs,j)
call rdderivs_xy_point(ex(1),ex(2),crho,sigma,KK(:,:,k),frs,i,j)
call rdderivs_x_point(ex(1),crho,KK(:,j,k),frr,i)
call rdderivs_x_point(ex(2),sigma,KK(i,:,k),fss,j)
call std_covdiff(crho(i),sigma(j),fs,fr,fss,frr,frs,covf)
dtomega(i,j,k) = -covf*omega(i,j,k)**3/6/m0/2
enddo
enddo
return
end subroutine get_dtomega
!!------------------------------------------------------------------------------------------------------------
!! input g_AB and Theta_AB are divided by r^2 indeed
!! input g_00 is also divided by r^2 indeed
subroutine get_omega_and_dtomega_LN(time,ex,crho,sigma,XX, &
omega,dtomega, Rmin,sst)
implicit none
! argument variables
integer, intent(in ):: ex(1:3),sst
real*8,intent(in) :: time,Rmin
double precision,intent(in),dimension(ex(1))::crho
double precision,intent(in),dimension(ex(2))::sigma
double precision,intent(in),dimension(ex(3))::XX
real*8,dimension(ex(1),ex(2),ex(3)),intent(out)::omega,dtomega
integer :: i,j,k
real*8 :: gr,gt,gp,tgrho,tgsigma,tc,ts,x,y,z
double complex :: II,Jr,Jrt
double complex :: Zslm,z020
double complex :: beta0,C1,C2,mx,my,mlx,mly
integer :: nu,m
call initial_null_paramter(beta0,C1,C2,nu,m)
II = dcmplx(0.d0,1.d0)
do i=1,ex(1)
do j=1,ex(2)
do k=1,ex(3)
! here fake global coordinate is enough
gr = 1.d0
tgrho = dtan(crho(i))
tgsigma = dtan(sigma(j))
tc = dsqrt((1.d0-dsin(crho(i))*dsin(sigma(j)))/2.d0)
ts = dsqrt((1.d0+dsin(crho(i))*dsin(sigma(j)))/2.d0)
select case (sst)
case (0)
z = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (1)
z = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = z*tgrho
y = z*tgsigma
case (2)
x = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (3)
x = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
y = x*tgrho
z = x*tgsigma
case (4)
y = gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case (5)
y = -gr/dsqrt(1+tgrho*tgrho+tgsigma*tgsigma)
x = y*tgrho
z = y*tgsigma
case default
write(*,*) "get_null_boundary3: not recognized sst = ",sst
return
end select
gt = dacos(z/gr)
gp = datan2(y,x)
z020 = Zslm(0,2,m,gt,gp)
Jr = (2.4d1*beta0+3.d0*II*nu*C1-II*nu**3*C2)/3.6d1
Jr = Jr*exp(II*nu*time)
Jrt = II*nu*Jr*exp(II*nu*time)
Jr = dsqrt(dble((2-1)))*dreal(Jr)*z020
Jrt = dsqrt(dble((2-1)))*dreal(Jrt)*z020
omega(i,j,k) = 1-dreal(Jr)
dtomega(i,j,k) = -dreal(Jrt)
enddo
enddo
enddo
return
end subroutine get_omega_and_dtomega_LN

5812
AMSS_NCKU_source/Null_Evolve/NullShellPatch.C Normal file
View File

File diff suppressed because it is too large Load Diff

189
AMSS_NCKU_source/Null_Evolve/NullShellPatch.h Normal file
View File

@@ -0,0 +1,189 @@
#ifndef NULLSHELLPATCH_H
#define NULLSHELLPATCH_H
#ifdef newc
#include <iostream>
#include <iomanip>
#include <fstream>
#include <cstdlib>
#include <cstdio>
#include <string>
#include <cmath>
#include <complex>
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>
#include <complex.h>
#endif
#include <mpi.h>
#include "MyList.h"
#include "Block.h"
#include "Parallel.h"
#include "ShellPatch.h"
#include "var.h"
#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width
#if (dim != 3)
#error NullShellPatch only supports 3 dimensional stuff yet
#endif
class xp_npatch : public ss_patch
{
public:
xp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 2; };
};
class xm_npatch : public ss_patch
{
public:
xm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 3; };
};
class yp_npatch : public ss_patch
{
public:
yp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 4; };
};
class ym_npatch : public ss_patch
{
public:
ym_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 5; };
};
class zp_npatch : public ss_patch
{
public:
zp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 0; };
};
class zm_npatch : public ss_patch
{
public:
zm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 1; };
};
class NullShellPatch
{
public:
struct pointstru
{
double gpox[dim]; // global cordinate
double lpox[dim]; // local cordinate
Block *Bg;
int ssst; //-1: cardisian, others as sst of ss_patch source sst
int tsst; //-1: cardisian, others as sst of ss_patch target sst
double *coef;
int *sind;
int dumyd; // the dimension which has common lines, only useful in interdata_packer
complex<double> swtf; // exp(i gamma) of Eq.(26) of CQG 24 S327
};
var *FXZEO;
var *gx, *gy, *gz;
// we always assume the number of VarList = 2* the number of Varwt
// so VarList must apear with pairs, either components of complex number or a fake pair
var *beta, *W;
var *Rnu, *Inu, *Rk, *Ik, *RB, *IB;
var *RQ, *IQ, *RU, *IU, *RTheta, *ITheta;
var *KK, *HKK, *KKx, *HKKx;
var *RJo, *IJo, *omegao;
var *RJ0, *IJ0, *omega0;
var *RJ, *IJ, *omega;
var *RJ1, *IJ1, *omega1;
var *RJ_rhs, *IJ_rhs, *omega_rhs;
var *quR1, *quR2, *quI1, *quI2;
var *qlR1, *qlR2, *qlI1, *qlI2;
var *gR, *gI;
var *dquR1, *dquR2, *dquI1, *dquI2;
var *bdquR1, *bdquR2, *bdquI1, *bdquI2;
var *dgR, *dgI;
var *bdgR, *bdgI;
var *RNews, *INews;
MyList<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
MyList<var> *OldStateList, *DumpList, *CheckList;
MyList<var> *betaList, *QUList, *WTheList, *TheList, *JrhsList, *J1List;
int betawt[1], QUwt[2], WThewt[2];
int myrank;
int shape[dim]; // for (rho, sigma, X), for rho and sigma means number of points for every pi/2
double Rmin, xmin, xmax;
int Symmetry;
int ingfs, fngfs;
MyList<ss_patch> *PatL;
MyList<pointstru> **ss_src, **ss_dst;
MyList<pointstru> **cs_src, **cs_dst;
public:
NullShellPatch(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetry, int myranki);
~NullShellPatch();
void destroypsuList(MyList<pointstru> *ct);
void fill_symmetric_boundarybuffer(MyList<var> *VarList, int *Varwt);
MyList<Block> *compose_sh(int cpusize);
int getdumydimension(int acsst, int posst);
void Setup_dyad();
void Setup_Initial_Data(bool checkrun, double PhysTime);
void eth_derivs(var *Rv, var *Iv, var *ethRv, var *ethIv, int s, int e);
void eth_dderivs(var *Rv, var *Iv, var *ethRv, var *ethIv, int s, int e1, int e2);
void getlocalpox_ss(int isst, double ix, double iy, double iz, int &sst, double &lx, double &ly, double &lz);
void getlocalpox_fake(double x, double y, double z, int &sst, double &lx, double &ly, double &lz);
void getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz);
void getlocalpoxsst_ss(int isst, double ix, double iy, double iz, int lsst, double &lx, double &ly, double &lz);
void getlocalpoxsst(double x, double y, double z, int sst, double &lx, double &ly, double &lz);
void getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz);
complex<double> get_swtf(double *pox, int tsst, int ssst);
void prolongpointstru(MyList<pointstru> *&psul, MyList<ss_patch> *sPpi, double DH[dim],
MyList<Patch> *Ppi, double CDH[dim], MyList<pointstru> *pss);
bool prolongpointstru(MyList<pointstru> *&psul, bool ssyn, int tsst, MyList<ss_patch> *sPp, double DH[dim],
MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in);
bool prolongpointstru_ss(MyList<pointstru> *&psul, int tsst, MyList<ss_patch> *sPp, double DH[dim],
MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in);
void setupintintstuff(int cpusize, MyList<Patch> *CPatL, int Symmetry);
void checkPatch();
void checkBlock(int sst);
double getdX(int dir);
void shellname(char *sn, int i);
void Dump_xyz(char *tag, double time, double dT);
void Dump_Data(MyList<var> *DumpListi, char *tag, double time, double dT);
void intertransfer(MyList<pointstru> **src, MyList<pointstru> **dst,
MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
int Symmetry, int *Varwt);
int interdata_packer(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, int *Varwt);
void Synch(MyList<var> *VarList, int Symmetry, int *Varwt);
void CS_Inter(MyList<var> *VarList, int Symmetry, int *Varwt);
void check_pointstrul(MyList<pointstru> *pp, bool first_only);
void check_pointstrul2(MyList<pointstru> *pp, int first_last_only);
void matchcheck(MyList<Patch> *CPatL);
void Interp_Points(MyList<var> *VarList,
int NN, double **XX, /*input global Cartesian coordinate*/
double *Shellf, int Symmetry);
void Interp_Points_2D(MyList<var> *VarList,
int NN, double **XX, /*input global Cartesian coordinate*/
double *Shellf, int Symmetry);
void Step(double dT, double PhysTime, monitor *ErrorMonitor);
void Null_Boundary(double PhysTime);
void HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count);
double News_Error_Check(double PhysTime, double dT, bool dp);
double Error_Check(double PhysTime, double dT, bool dp);
double EqTheta_Check(double PhysTime, double dT, bool dp);
void Compute_News(double PhysTime, double dT, bool dp);
void Check_News(double PhysTime, double dT, bool dp);
};
#endif /* NULLSHELLPATCH_H */

2684
AMSS_NCKU_source/Null_Evolve/NullShellPatch2.C Normal file
View File

File diff suppressed because it is too large Load Diff

183
AMSS_NCKU_source/Null_Evolve/NullShellPatch2.h Normal file
View File

@@ -0,0 +1,183 @@
#ifndef NULLSHELLPATCH2_H
#define NULLSHELLPATCH2_H
#ifdef newc
#include <iostream>
#include <iomanip>
#include <fstream>
#include <cstdlib>
#include <cstdio>
#include <string>
#include <cmath>
#include <complex>
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>
#include <complex.h>
#endif
#include <mpi.h>
#include "MyList.h"
#include "Block.h"
#include "Parallel.h"
#include "ShellPatch.h"
#include "var.h"
#include "macrodef.h" //need dim here; Vertex or Cell; ghost_width
#if (dim != 3)
#error NullShellPatch2 only supports 3 dimensional stuff yet
#endif
// x x x x x o *
// * o x x x x x
// each side contribute an overlap points
// so we need half of that
#define overghost ((ghost_width + 1) / 2 + ghost_width)
class NullShellPatch2
{
class xp_npatch : public ss_patch
{
public:
xp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 2; };
};
class xm_npatch : public ss_patch
{
public:
xm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 3; };
};
class yp_npatch : public ss_patch
{
public:
yp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 4; };
};
class ym_npatch : public ss_patch
{
public:
ym_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 5; };
};
class zp_npatch : public ss_patch
{
public:
zp_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 0; };
};
class zm_npatch : public ss_patch
{
public:
zm_npatch(int ingfsi, int fngfsi, int *shapei, double *bboxi, int myranki) : ss_patch(ingfsi, fngfsi, shapei, bboxi, myranki) { sst = 1; };
};
public:
struct pointstru
{
double gpox[dim]; // global cordinate
double lpox[dim]; // local cordinate
Block *Bg;
int ssst; //-1: cardisian, others as sst of ss_patch source sst
int tsst; //-1: cardisian, others as sst of ss_patch target sst
double *coef;
int *sind; // index position, considered dummy dimension already
int dumyd; // the dimension which has common lines, only useful in interdata_packer
double Jacob[2][2];
int indz; // index position of r direction
};
var *gx, *gy, *gz;
// surface variable
var *g00, *g01, *p02, *p03, *g02, *g03;
var *Theta22, *Theta23, *Theta33;
// evolution variables
var *g22o, *g23o, *g33o;
var *g220, *g230, *g330;
var *g22, *g23, *g33;
var *g221, *g231, *g331;
var *g22_rhs, *g23_rhs, *g33_rhs;
var *RNews, *INews;
var *omega, *dtomega;
MyList<var> *StateList, *SynchList_pre, *SynchList_cor, *RHSList;
MyList<var> *OldStateList, *DumpList, *CheckList;
MyList<var> *NewsList;
MyList<var> *g01List, *pg0AList, *g00List, *ThetaList;
double **g01wt, **pg0Awt, **g00wt, **Thetawt;
int myrank;
int shape[dim]; // for (rho, sigma, X), for rho and sigma means number of points for every pi/2
double Rmin, xmin, xmax;
int Symmetry;
int ingfs, fngfs;
MyList<ss_patch> *PatL;
MyList<pointstru> **ss_src, **ss_dst;
MyList<pointstru> **cs_src, **cs_dst;
public:
NullShellPatch2(int *shapei, double Rmini, double xmini, double xmaxi, int Symmetry, int myranki);
~NullShellPatch2();
double getdX(int dir);
void shellname(char *sn, int i);
void destroypsuList(MyList<pointstru> *ct);
MyList<Block> *compose_sh(int cpusize);
void Dump_xyz(char *tag, double time, double dT);
void Dump_Data(MyList<var> *DumpListi, char *tag, double time, double dT);
void setupintintstuff(int cpusize, MyList<Patch> *CPatL, int Symmetry);
void getlocalpox_ss(int isst, double ix, double iy, double iz, int &sst, double &lx, double &ly, double &lz);
void getlocalpox_fake(double x, double y, double z, int &sst, double &lx, double &ly, double &lz);
void getlocalpox(double x, double y, double z, int &sst, double &lx, double &ly, double &lz);
void getlocalpoxsst_ss(int isst, double ix, double iy, double iz, int lsst, double &lx, double &ly, double &lz);
void getlocalpoxsst(double x, double y, double z, int sst, double &lx, double &ly, double &lz);
void getglobalpox(double &x, double &y, double &z, int sst, double lx, double ly, double lz);
int getdumydimension(int acsst, int posst);
void get_Jacob(double *pox, int tsst, int ssst, double J[2][2]);
void prolongpointstru(MyList<pointstru> *&psul, MyList<ss_patch> *sPpi, double DH[dim],
MyList<Patch> *Ppi, double CDH[dim], MyList<pointstru> *pss);
bool prolongpointstru(MyList<pointstru> *&psul, bool ssyn, int tsst, MyList<ss_patch> *sPp, double DH[dim],
MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, const int iz);
bool prolongpointstru_ss(MyList<pointstru> *&psul, int tsst, MyList<ss_patch> *sPp, double DH[dim],
MyList<Patch> *Pp, double CDH[dim], double x, double y, double z, int Symmetry, int rank_in, const int iz);
void Setup_Initial_Data(bool checkrun, double PhysTime);
void Step(double dT, double PhysTime, monitor *ErrorMonitor);
void HyperSlice(double dT, double PhysTime, monitor *ErrorMonitor, int RK_count);
void Synch(MyList<var> *VarList, int Symmetry, double **Varwt, const short int svt);
void fill_symmetric_boundarybuffer(MyList<var> *VarList, double **Varwt);
void intertransfer(MyList<pointstru> **src, MyList<pointstru> **dst,
MyList<var> *VarList1 /* source */, MyList<var> *VarList2 /*target */,
int Symmetry, double **Varwt, const short int svt);
int interdata_packer(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, double **Varwt,
const short int svt);
int interdata_packer_pre(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, double **Varwt,
const short int svt);
int interdata_packer_pot(double *data, MyList<pointstru> *src, MyList<pointstru> *dst, int rank_in, int dir,
MyList<var> *VarLists /* source */, MyList<var> *VarListd /* target */, int Symmetry, double **Varwt,
const short int svt);
void check_pointstrul(MyList<pointstru> *pp, bool first_only);
void checkBlock(int sst);
void Null_Boundary(double PhysTime);
void Compute_News(double PhysTime);
void Interp_Points_2D(MyList<var> *VarList,
int NN, double **XX, /*input fake global Cartesian coordinate*/
double *Shellf, int Symmetry);
double Error_Check(double PhysTime);
};
#endif /* NULLSHELLPATCH2_H */

1036
AMSS_NCKU_source/Null_Evolve/NullShellPatch2_Evo.C Normal file
View File

File diff suppressed because it is too large Load Diff

216
AMSS_NCKU_source/Null_Evolve/testNull.C Normal file
View File

@@ -0,0 +1,216 @@
// $Id: testNull.C,v 1.8 2013/03/06 04:16:04 zjcao Exp $
#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 "macrodef.h"
#include "NullShellPatch.h"
#include "monitor.h"
#include "surface_integral.h"
#define PI M_PI
//=======================================
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, CheckTime;
double Courant;
double numepss, numepsb;
int Symmetry;
int a_lev, maxl, decn;
double maxrex, drex;
int shapei[dim];
double Rmin, xmin, xmax;
// double RJerror[2];
double RJerror;
// read parameter from file
{
char filename[100] = "input.par";
const int LEN = 256;
char pline[LEN];
string str, sgrp, skey, sval;
int sind;
ifstream inf(filename, ifstream::in);
if (!inf.good())
{
cout << "Can not open parameter file " << filename
<< " for inputing information of Shell patches" << 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 " << filename << " in line " << i << endl;
MPI_Abort(MPI_COMM_WORLD, 1);
}
else if (status == 0)
continue;
if (sgrp == "BSSN")
{
if (skey == "Shell shape")
shapei[sind] = atof(sval.c_str());
else if (skey == "Rmin")
Rmin = atof(sval.c_str());
else if (skey == "xmin")
xmin = atof(sval.c_str());
else if (skey == "xmax")
xmax = atof(sval.c_str());
}
if (sgrp == "ABE")
{
if (skey == "Symmetry")
Symmetry = atoi(sval.c_str());
else if (skey == "Courant")
Courant = atof(sval.c_str());
else if (skey == "DumpTime")
DumpTime = atof(sval.c_str());
else if (skey == "TotalTime")
TotalTime = atof(sval.c_str());
else if (skey == "AnalysisTime")
AnasTime = atof(sval.c_str());
else if (skey == "Max mode l")
maxl = atoi(sval.c_str());
}
}
inf.close();
}
monitor *ECmonitor, *NewsMonitor;
// setup Monitors
{
stringstream a_stream;
a_stream.setf(ios::left);
a_stream << "# time L2norm_of_error";
ECmonitor = new monitor("error.dat", myrank, a_stream.str());
a_stream.clear();
a_stream.str("");
a_stream << setw(15) << "# time";
char str[50];
for (int pl = 2; pl < maxl + 1; pl++)
for (int pm = -pl; pm < pl + 1; pm++)
{
sprintf(str, "R%02dm%03d", pl, pm);
a_stream << setw(16) << str;
sprintf(str, "I%02dm%03d", pl, pm);
a_stream << setw(16) << str;
}
NewsMonitor = new monitor("null_news.dat", myrank, a_stream.str());
}
//===========================the computation body====================================================
NullShellPatch *ADM;
surface_integral *Waveshell;
// setup sphere integration engine
Waveshell = new surface_integral(Symmetry);
ADM = new NullShellPatch(shapei, Rmin, xmin, xmax, Symmetry, myrank);
ADM->compose_sh(nprocs);
ADM->Setup_dyad();
ADM->Dump_xyz(0, 0, 1);
ADM->setupintintstuff(nprocs, 0, Symmetry);
double PhysTime = 0, dT = Courant * PI / 4 / shapei[0];
double LastDump = 0, LastAnas = 0;
ADM->Setup_Initial_Data(false, PhysTime);
while (PhysTime < TotalTime)
{
if (LastAnas >= AnasTime)
{
double *RP, *IP;
int NN = 0;
for (int pl = 2; pl < maxl + 1; pl++)
for (int pm = -pl; pm < pl + 1; pm++)
NN++;
RP = new double[NN];
IP = new double[NN];
// ADM->Check_News(PhysTime,dT,false);
#ifdef Vertex
#ifdef Cell
#error Both Cell and Vertex are defined
#endif
Waveshell->surf_Wave(ADM->xmax, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0);
#else
#ifdef Cell
Waveshell->surf_Wave(ADM->xmax - (ADM->getdX(2)) / 2.0, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0);
#else
#error Not define Vertex nor Cell
#endif
#endif
NewsMonitor->writefile(PhysTime, NN, RP, IP);
delete[] RP;
delete[] IP;
RJerror = ADM->Error_Check(PhysTime, dT, (LastDump >= DumpTime));
// RJerror[1]=ADM->News_Error_Check(PhysTime,dT,(LastDump >= DumpTime));
// RJerror[0]=ADM->EqTheta_Check(PhysTime,dT,(LastDump >= DumpTime));
ECmonitor->writefile(PhysTime, 1, &RJerror);
LastAnas = 0;
}
if (LastDump >= DumpTime)
{
ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT);
LastDump = 0;
}
ADM->Step(dT, PhysTime, 0);
PhysTime += dT;
LastDump += dT;
LastAnas += dT;
if (myrank == 0)
cout << "Time = " << PhysTime << endl;
// ADM->Dump_Data(ADM->StateList,0,PhysTime,dT);
}
ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT);
delete ADM;
delete ECmonitor;
delete NewsMonitor;
delete Waveshell;
//=======================caculation done=============================================================
if (myrank == 0)
cout << "===============================================================" << endl;
if (myrank == 0)
cout << "Simulation is successfully done!!" << endl;
MPI_Finalize();
exit(0);
}

274
AMSS_NCKU_source/Null_Evolve/testNull2.C Normal file
View File

@@ -0,0 +1,274 @@
// $Id: testNull2.C,v 1.1 2013/08/20 11:49:05 zjcao Exp $
#ifdef newc
#include <iostream>
#include <iomanip>
#include <fstream>
#include <cstdlib>
#include <cstdio>
#include <string>
#include <cmath>
#include <map>
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>
#include <map.h>
#endif
#include <mpi.h>
#include "misc.h"
#include "macrodef.h"
#include "NullShellPatch2.h"
#include "monitor.h"
#include "surface_integral.h"
#define PI M_PI
namespace parameters
{
map<string, int> int_par;
map<string, double> dou_par;
map<string, string> str_par;
}
//=======================================
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, CheckTime;
double Courant;
double numepss, numepsb;
int Symmetry;
int a_lev, maxl, decn;
double maxrex, drex;
int shapei[dim];
double Rmin, xmin, xmax;
if (argc > 1)
{
string sttr(argv[1]);
parameters::str_par.insert(map<string, string>::value_type("inputpar", sttr));
}
else
{
string sttr("input.par");
parameters::str_par.insert(map<string, string>::value_type("inputpar", sttr));
}
// read parameter from file
{
string out_dir;
char filename[50];
{
map<string, string>::iterator iter = parameters::str_par.find("inputpar");
if (iter != parameters::str_par.end())
{
strcpy(filename, (iter->second).c_str());
}
else
{
cout << "Error inputpar" << endl;
exit(0);
}
}
const int LEN = 256;
char pline[LEN];
string str, sgrp, skey, sval;
int sind;
ifstream inf(filename, ifstream::in);
if (!inf.good())
{
cout << "Can not open parameter file " << filename
<< " for inputing information of Shell patches" << 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 " << filename << " in line " << i << endl;
MPI_Abort(MPI_COMM_WORLD, 1);
}
else if (status == 0)
continue;
if (sgrp == "BSSN")
{
if (skey == "Shell shape")
shapei[sind] = atof(sval.c_str());
else if (skey == "Rmin")
Rmin = atof(sval.c_str());
else if (skey == "xmin")
xmin = atof(sval.c_str());
else if (skey == "xmax")
xmax = atof(sval.c_str());
}
if (sgrp == "ABE")
{
if (skey == "Symmetry")
Symmetry = atoi(sval.c_str());
else if (skey == "Courant")
Courant = atof(sval.c_str());
else if (skey == "DumpTime")
DumpTime = atof(sval.c_str());
else if (skey == "TotalTime")
TotalTime = atof(sval.c_str());
else if (skey == "AnalysisTime")
AnasTime = atof(sval.c_str());
else if (skey == "Max mode l")
maxl = atoi(sval.c_str());
else if (skey == "output dir")
out_dir = sval;
}
}
inf.close();
map<string, string>::iterator iter;
iter = parameters::str_par.find("output dir");
if (iter != parameters::str_par.end())
{
out_dir = iter->second;
}
else
{
parameters::str_par.insert(map<string, string>::value_type("output dir", out_dir));
}
if (myrank == 0)
{
char cmd[100];
sprintf(cmd, "rm %s -rf", out_dir.c_str());
system(cmd);
sprintf(cmd, "mkdir %s", out_dir.c_str());
system(cmd);
}
}
monitor *ECmonitor, *NewsMonitor;
// setup Monitors
{
stringstream a_stream;
a_stream.setf(ios::left);
a_stream << "# time L2norm_of_error";
ECmonitor = new monitor("error.dat", myrank, a_stream.str());
a_stream.clear();
a_stream.str("");
a_stream << setw(15) << "# time";
char str[50];
for (int pl = 2; pl < maxl + 1; pl++)
for (int pm = -pl; pm < pl + 1; pm++)
{
sprintf(str, "R%02dm%03d", pl, pm);
a_stream << setw(16) << str;
sprintf(str, "I%02dm%03d", pl, pm);
a_stream << setw(16) << str;
}
NewsMonitor = new monitor("null_news.dat", myrank, a_stream.str());
}
//===========================the computation body====================================================
NullShellPatch2 *ADM;
surface_integral *Waveshell;
// setup sphere integration engine
Waveshell = new surface_integral(Symmetry);
ADM = new NullShellPatch2(shapei, Rmin, xmin, xmax, Symmetry, myrank);
ADM->compose_sh(nprocs);
ADM->Dump_xyz(0, 0, 1);
ADM->setupintintstuff(nprocs, 0, Symmetry);
double PhysTime = 0, dT = Courant * PI / 4 / shapei[0];
double LastDump = 0, LastAnas = 0;
ADM->Setup_Initial_Data(false, PhysTime);
// check Synch
// ADM->Synch(ADM->StateList,Symmetry,ADM->Thetawt,3,-1);
// ADM->Dump_Data(ADM->StateList,0,PhysTime,dT);
// exit(0);
while (PhysTime < TotalTime)
{
ADM->Step(dT, PhysTime, 0);
PhysTime += dT;
LastDump += dT;
LastAnas += dT;
if (myrank == 0)
cout << "Time = " << PhysTime << endl;
if (LastAnas >= AnasTime)
{
double *RP, *IP;
int NN = 0;
for (int pl = 2; pl < maxl + 1; pl++)
for (int pm = -pl; pm < pl + 1; pm++)
NN++;
RP = new double[NN];
IP = new double[NN];
ADM->Compute_News(PhysTime);
#ifdef Vertex
#ifdef Cell
#error Both Cell and Vertex are defined
#endif
Waveshell->surf_Wave(ADM->xmax, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0);
#else
#ifdef Cell
Waveshell->surf_Wave(ADM->xmax - (ADM->getdX(2)) / 2.0, 0, ADM, ADM->RNews, ADM->INews, 2, maxl, NN, RP, IP, 0);
#else
#error Not define Vertex nor Cell
#endif
#endif
NewsMonitor->writefile(PhysTime, NN, RP, IP);
delete[] RP;
delete[] IP;
double RJerror;
RJerror = ADM->Error_Check(PhysTime);
ECmonitor->writefile(PhysTime, 1, &RJerror);
LastAnas = 0;
}
if (LastDump >= DumpTime)
{
ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT);
ADM->Dump_Data(ADM->g01List, 0, PhysTime, dT);
ADM->Dump_Data(ADM->pg0AList, 0, PhysTime, dT);
ADM->Dump_Data(ADM->g00List, 0, PhysTime, dT);
ADM->Dump_Data(ADM->ThetaList, 0, PhysTime, dT);
LastDump = 0;
}
}
ADM->Dump_Data(ADM->StateList, 0, PhysTime, dT);
delete ADM;
//=======================caculation done=============================================================
if (myrank == 0)
cout << "===============================================================" << endl;
if (myrank == 0)
cout << "Simulation is successfully done!!" << endl;
MPI_Finalize();
exit(0);
}