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

Optimize BSSN EScalar GPU path baseline

Browse Source
This commit is contained in:
CGH0S7
2026-05-02 18:19:15 +08:00
parent 52beb4d153
commit 59a216ad93
13 changed files with 1366 additions and 177 deletions
Download Patch File Download Diff File Expand all files Collapse all files

142
AMSS_NCKU_source/bssnEScalar_rhs.f90
View File

@@ -3,11 +3,143 @@
!! note that the potential for scalar field in F(R) gravity
!! is defined in the file Set_Rho_ADM.f90
#include "macrodef.fh"
! rhs for scalar and GR variables
! here we consider vacuum spacetime only
function compute_rhs_bssn_escalar(ex, T,X, Y, Z, &
#include "macrodef.fh"
! scalar RHS and stress-energy only; BSSN RHS can be supplied by CUDA.
function compute_rhs_bssn_escalar_matter(ex, T, X, Y, Z, &
chi , trK , &
dxx , gxy , gxz , dyy , gyz , dzz, &
Axx , Axy , Axz , Ayy , Ayz , Azz, &
Gamx , Gamy , Gamz , &
Lap , betax , betay , betaz , &
dtSfx , dtSfy , dtSfz , &
Sphi , Spi , &
Sphi_rhs , Spi_rhs , &
rho,Sx,Sy,Sz,Sxx,Sxy,Sxz,Syy,Syz,Szz, &
Symmetry,Lev,eps) result(gont)
implicit none
integer,intent(in ):: ex(1:3), Symmetry,Lev
real*8, intent(in ):: T
real*8, intent(in ):: X(1:ex(1)),Y(1:ex(2)),Z(1:ex(3))
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: chi,dxx,dyy,dzz
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: trK
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: gxy,gxz,gyz
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Axx,Axy,Axz,Ayy,Ayz,Azz
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: Gamx,Gamy,Gamz
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Lap, betax, betay, betaz
real*8, dimension(ex(1),ex(2),ex(3)),intent(in ) :: dtSfx, dtSfy, dtSfz
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, dimension(ex(1),ex(2),ex(3)),intent(inout) :: rho,Sx,Sy,Sz
real*8, dimension(ex(1),ex(2),ex(3)),intent(inout) :: Sxx,Sxy,Sxz,Syy,Syz,Szz
real*8,intent(in) :: eps
integer::gont
real*8, dimension(ex(1),ex(2),ex(3)) :: gxx,gyy,gzz
real*8, dimension(ex(1),ex(2),ex(3)) :: chix,chiy,chiz
real*8, dimension(ex(1),ex(2),ex(3)) :: Lapx,Lapy,Lapz
real*8, dimension(ex(1),ex(2),ex(3)) :: Kx,Ky,Kz,S
real*8, dimension(ex(1),ex(2),ex(3)) :: f,fxx,fxy,fxz,fyy,fyz,fzz
real*8, dimension(ex(1),ex(2),ex(3)) :: alpn1,chin1
real*8, dimension(ex(1),ex(2),ex(3)) :: gupxx,gupxy,gupxz
real*8, dimension(ex(1),ex(2),ex(3)) :: gupyy,gupyz,gupzz
real*8 :: dX
real*8, parameter :: ZEO=0.d0, ONE = 1.D0, TWO = 2.D0, HALF = 0.5D0
real*8, parameter :: SYM = 1.D0
dX = sum(chi)+sum(trK)+sum(dxx)+sum(gxy)+sum(gxz)+sum(dyy)+sum(gyz)+sum(dzz) &
+sum(Gamx)+sum(Gamy)+sum(Gamz) &
+sum(Lap)+sum(Sphi)+sum(Spi)
if(dX.ne.dX) then
if(sum(chi).ne.sum(chi))write(*,*)"bssn_escalar_matter: find NaN in chi"
if(sum(trK).ne.sum(trK))write(*,*)"bssn_escalar_matter: find NaN in trk"
if(sum(dxx).ne.sum(dxx))write(*,*)"bssn_escalar_matter: find NaN in dxx"
if(sum(gxy).ne.sum(gxy))write(*,*)"bssn_escalar_matter: find NaN in gxy"
if(sum(gxz).ne.sum(gxz))write(*,*)"bssn_escalar_matter: find NaN in gxz"
if(sum(dyy).ne.sum(dyy))write(*,*)"bssn_escalar_matter: find NaN in dyy"
if(sum(gyz).ne.sum(gyz))write(*,*)"bssn_escalar_matter: find NaN in gyz"
if(sum(dzz).ne.sum(dzz))write(*,*)"bssn_escalar_matter: find NaN in dzz"
if(sum(Gamx).ne.sum(Gamx))write(*,*)"bssn_escalar_matter: find NaN in Gamx"
if(sum(Gamy).ne.sum(Gamy))write(*,*)"bssn_escalar_matter: find NaN in Gamy"
if(sum(Gamz).ne.sum(Gamz))write(*,*)"bssn_escalar_matter: find NaN in Gamz"
if(sum(Lap).ne.sum(Lap))write(*,*)"bssn_escalar_matter: find NaN in Lap"
if(sum(Sphi).ne.sum(Sphi))write(*,*)"bssn_escalar_matter: find NaN in Sphi"
if(sum(Spi).ne.sum(Spi))write(*,*)"bssn_escalar_matter: find NaN in Spi"
gont = 1
return
endif
alpn1 = Lap + ONE
chin1 = chi + ONE
gxx = dxx + ONE
gyy = dyy + ONE
gzz = dzz + ONE
call fderivs(ex,chi,chix,chiy,chiz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev)
call fderivs(ex,Lap,Lapx,Lapy,Lapz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev)
gupzz = gxx * gyy * gzz + gxy * gyz * gxz + gxz * gxy * gyz - &
gxz * gyy * gxz - gxy * gxy * gzz - gxx * gyz * gyz
gupxx = ( gyy * gzz - gyz * gyz ) / gupzz
gupxy = - ( gxy * gzz - gyz * gxz ) / gupzz
gupxz = ( gxy * gyz - gyy * gxz ) / gupzz
gupyy = ( gxx * gzz - gxz * gxz ) / gupzz
gupyz = - ( gxx * gyz - gxy * gxz ) / gupzz
gupzz = ( gxx * gyy - gxy * gxy ) / gupzz
#if 1
Sphi_rhs = alpn1 * Spi
call fderivs(ex,Sphi,Kx,Ky,Kz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev)
call fdderivs(ex,Sphi,fxx,fxy,fxz,fyy,fyz,fzz,X,Y,Z,SYM,SYM,SYM,Symmetry,Lev)
Spi_rhs = gupxx * fxx + gupyy * fyy + gupzz * fzz + &
( gupxy * fxy + gupxz * fxz + gupyz * fyz ) * TWO - &
((Gamx+(gupxx*chix+gupxy*chiy+gupxz*chiz)/TWO/chin1)*Kx &
+ (Gamy+(gupxy*chix+gupyy*chiy+gupyz*chiz)/TWO/chin1)*Ky &
+ (Gamz+(gupxz*chix+gupyz*chiy+gupzz*chiz)/TWO/chin1)*Kz)
Spi_rhs = Spi_rhs*alpn1 + &
(gupxx*Lapx*Kx + gupxy*Lapx*Ky + gupxz*Lapx*Kz &
+gupxy*Lapy*Kx + gupyy*Lapy*Ky + gupyz*Lapy*Kz &
+gupxz*Lapz*Kx + gupyz*Lapz*Ky + gupzz*Lapz*Kz)
call frpotential(ex,Sphi,f,S)
Spi_rhs = Spi_rhs*chin1 + alpn1*(trK*Spi - S)
rho = chin1*((gupxx * Kx * Kx + gupyy * Ky * Ky + gupzz * Kz * Kz)/TWO + &
gupxy * Kx * Ky + gupxz * Kx * Kz + gupyz * Ky * Kz ) &
+ Spi*Spi/TWO+f
Sx = -Spi*Kx
Sy = -Spi*Ky
Sz = -Spi*Kz
f = (rho - Spi*Spi)/chin1
Sxx = Kx*Kx-f*gxx
Sxy = Kx*Ky-f*gxy
Sxz = Kx*Kz-f*gxz
Syy = Ky*Ky-f*gyy
Syz = Ky*Kz-f*gyz
Szz = Kz*Kz-f*gzz
#else
Sphi_rhs = ZEO
Spi_rhs = ZEO
rho = ZEO
Sx = ZEO
Sy = ZEO
Sz = ZEO
Sxx = ZEO
Sxy = ZEO
Sxz = ZEO
Syy = ZEO
Syz = ZEO
Szz = ZEO
#endif
gont = 0
return
end function compute_rhs_bssn_escalar_matter
! rhs for scalar and GR variables
! here we consider vacuum spacetime only
function compute_rhs_bssn_escalar(ex, T,X, Y, Z, &
chi , trK , &
dxx , gxy , gxz , dyy , gyz , dzz, &
Axx , Axy , Axz , Ayy , Ayz , Azz, &