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

Optimize prolong3: precompute coarse index/parity maps

Browse Source 
(cherry picked from commit 2c0a3055d4)
This commit is contained in:
CGH0S7
2026-02-28 23:53:30 +08:00
committed by ianchb
parent e7a02e8f72
commit 7109474a14
1 changed files with 68 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
AMSS_NCKU_source/prolongrestrict_cell.f90
View File

@@ -1936,6 +1936,12 @@
integer :: i,j,k,ii,jj,kk
real*8, dimension(6,6) :: tmp2
real*8, dimension(6) :: tmp1
integer, dimension(extf(1)) :: cix
integer, dimension(extf(2)) :: ciy
integer, dimension(extf(3)) :: ciz
logical, dimension(extf(1)) :: evenx
logical, dimension(extf(2)) :: eveny
logical, dimension(extf(3)) :: evenz
real*8, parameter :: C1=7.7d1/8.192d3,C2=-6.93d2/8.192d3,C3=3.465d3/4.096d3
real*8, parameter :: C6=6.3d1/8.192d3,C5=-4.95d2/8.192d3,C4=1.155d3/4.096d3
@@ -2019,26 +2025,33 @@
return
endif
do i = imino,imaxo
ii = i + lbf(1) - 1
cix(i) = ii/2 - lbc(1) + 1
evenx(i) = (ii/2*2 == ii)
enddo
do j = jmino,jmaxo
jj = j + lbf(2) - 1
ciy(j) = jj/2 - lbc(2) + 1
eveny(j) = (jj/2*2 == jj)
enddo
do k = kmino,kmaxo
kk = k + lbf(3) - 1
ciz(k) = kk/2 - lbc(3) + 1
evenz(k) = (kk/2*2 == kk)
enddo
call symmetry_bd(3,extc,func,funcc,SoA)
!~~~~~~> prolongation start...
do k = kmino,kmaxo
do j = jmino,jmaxo
do i = imino,imaxo
cxI(1) = i
cxI(2) = j
cxI(3) = k
! change to coarse level reference
!|---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*--- ---*---|
!|=======x===============x===============x===============x=======|
cxI = (cxI+lbf-1)/2
! change to array index
cxI = cxI - lbc + 1
cxI(1) = cix(i)
cxI(2) = ciy(j)
cxI(3) = ciz(k)
if(any(cxI+3 > extc)) write(*,*)"error in prolong"
ii=i+lbf(1)-1
jj=j+lbf(2)-1
kk=k+lbf(3)-1
#if 0
if(ii/2*2==ii)then
if(jj/2*2==jj)then
@@ -2126,7 +2139,7 @@
endif
endif
#else
if(kk/2*2==kk)then
if(evenz(k))then
tmp2= C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-2)+&
C2*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)-1)+&
C3*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3) )+&
@@ -2142,13 +2155,13 @@
C1*funcc(cxI(1)-2:cxI(1)+3,cxI(2)-2:cxI(2)+3,cxI(3)+3)
endif
if(jj/2*2==jj)then
if(eveny(j))then
tmp1= C1*tmp2(:,1)+C2*tmp2(:,2)+C3*tmp2(:,3)+C4*tmp2(:,4)+C5*tmp2(:,5)+C6*tmp2(:,6)
else
tmp1= C6*tmp2(:,1)+C5*tmp2(:,2)+C4*tmp2(:,3)+C3*tmp2(:,4)+C2*tmp2(:,5)+C1*tmp2(:,6)
endif
if(ii/2*2==ii)then
if(evenx(i))then
funf(i,j,k)= C1*tmp1(1)+C2*tmp1(2)+C3*tmp1(3)+C4*tmp1(4)+C5*tmp1(5)+C6*tmp1(6)
else
funf(i,j,k)= C6*tmp1(1)+C5*tmp1(2)+C4*tmp1(3)+C3*tmp1(4)+C2*tmp1(5)+C1*tmp1(6)