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

Add conservative fmisc safe mode

Browse Source
This commit is contained in:
CGH0S7
2026-05-17 00:35:17 +08:00
parent 3806e82c47
commit 6f62e75245
3 changed files with 140 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
AMSS_NCKU_source/fmisc.f90
View File

@@ -324,6 +324,9 @@ subroutine symmetry_bd(ord,extc,func,funcc,SoA)
integer::i
#if USE_FMISC_SAFE_MODE
funcc = 0.d0
#endif
funcc(1:extc(1),1:extc(2),1:extc(3)) = func
do i=0,ord-1
funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1)
@@ -349,6 +352,9 @@ subroutine symmetry_tbd(ord,extc,func,funcc,SoA)
integer::i
#if USE_FMISC_SAFE_MODE
funcc = 0.d0
#endif
funcc(1:extc(1),1:extc(2),1:extc(3)) = func
do i=0,ord-1
funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1)
@@ -377,6 +383,9 @@ subroutine symmetry_stbd(ord,extc,func,funcc,SoA)
integer::i
#if USE_FMISC_SAFE_MODE
funcc = 0.d0
#endif
funcc(1:extc(1),1:extc(2),1:extc(3)) = func
do i=0,ord-1
funcc(-i,1:extc(2),1:extc(3)) = funcc(i+2,1:extc(2),1:extc(3))*SoA(1)
@@ -1119,6 +1128,10 @@ end subroutine d2dump
#define POLINT6_USE_BARYCENTRIC 1
#endif
#ifndef USE_FMISC_SAFE_MODE
#define USE_FMISC_SAFE_MODE 0
#endif
!DIR$ ATTRIBUTES FORCEINLINE :: polint6_neville
subroutine polint6_neville(xa, ya, x, y, dy)
implicit none
@@ -1271,7 +1284,9 @@ end subroutine d2dump
real*8 :: dif, dift, hp, h, den_val
if (ordn == 6) then
#if POLINT6_USE_BARYCENTRIC
#if USE_FMISC_SAFE_MODE
call polint6_neville(xa, ya, x, y, dy)
#elif POLINT6_USE_BARYCENTRIC
call polint6_barycentric(xa, ya, x, y, dy)
#else
call polint6_neville(xa, ya, x, y, dy)
@@ -1376,7 +1391,7 @@ end subroutine d2dump
real*8, intent(in) :: x1,x2
real*8, intent(out) :: y,dy
#ifdef POLINT_LEGACY_ORDER
#if USE_FMISC_SAFE_MODE || defined(POLINT_LEGACY_ORDER)
integer :: i,m
real*8, dimension(ordn) :: ymtmp
real*8, dimension(ordn) :: yntmp
@@ -1414,7 +1429,7 @@ end subroutine d2dump
real*8, intent(in) :: x1,x2,x3
real*8, intent(out) :: y,dy
#ifdef POLINT_LEGACY_ORDER
#if USE_FMISC_SAFE_MODE || defined(POLINT_LEGACY_ORDER)
integer :: i,j,m,n
real*8, dimension(ordn,ordn) :: yatmp
real*8, dimension(ordn) :: ymtmp
@@ -1502,12 +1517,23 @@ if(dabs(X(1)-xmin) < dX) imin = 1
if(dabs(Y(1)-ymin) < dY) jmin = 1
if(dabs(Z(1)-zmin) < dZ) kmin = 1
#if USE_FMISC_SAFE_MODE
f_out = 0.d0
do k = kmin, kmax
do j = jmin, jmax
do i = imin, imax
f_out = f_out + f(i,j,k)*f(i,j,k)
end do
end do
end do
#else
! Optimized with oneMKL BLAS DDOT for dot product
n_elements = (imax-imin+1)*(jmax-jmin+1)*(kmax-kmin+1)
allocate(f_flat(n_elements))
f_flat = reshape(f(imin:imax,jmin:jmax,kmin:kmax), [n_elements])
f_out = DDOT(n_elements, f_flat, 1, f_flat, 1)
deallocate(f_flat)
n_elements = (imax-imin+1)*(jmax-jmin+1)*(kmax-kmin+1)
allocate(f_flat(n_elements))
f_flat = reshape(f(imin:imax,jmin:jmax,kmin:kmax), [n_elements])
f_out = DDOT(n_elements, f_flat, 1, f_flat, 1)
deallocate(f_flat)
#endif
f_out = f_out*dX*dY*dZ
@@ -1565,7 +1591,9 @@ if(dabs(Z(1)-zmin) < dZ) kmin = 1
do k=kmin,kmax
do j=jmin,jmax
#if !USE_FMISC_SAFE_MODE
!DIR$ SIMD REDUCTION(+:s1,s2,s3,s4,s5,s6,s7)
#endif
do i=imin,imax
s1 = s1 + f1(i,j,k)*f1(i,j,k)
s2 = s2 + f2(i,j,k)*f2(i,j,k)
@@ -1672,12 +1700,23 @@ if(Symmetry==2)then
if(dabs(ymin+gw*dY)<dY.and.Y(1)<0.d0) jmin = gw+1
endif
#if USE_FMISC_SAFE_MODE
f_out = 0.d0
do k = kmin, kmax
do j = jmin, jmax
do i = imin, imax
f_out = f_out + f(i,j,k)*f(i,j,k)
end do
end do
end do
#else
! Optimized with oneMKL BLAS DDOT for dot product
n_elements = (imax-imin+1)*(jmax-jmin+1)*(kmax-kmin+1)
allocate(f_flat(n_elements))
f_flat = reshape(f(imin:imax,jmin:jmax,kmin:kmax), [n_elements])
f_out = DDOT(n_elements, f_flat, 1, f_flat, 1)
deallocate(f_flat)
n_elements = (imax-imin+1)*(jmax-jmin+1)*(kmax-kmin+1)
allocate(f_flat(n_elements))
f_flat = reshape(f(imin:imax,jmin:jmax,kmin:kmax), [n_elements])
f_out = DDOT(n_elements, f_flat, 1, f_flat, 1)
deallocate(f_flat)
#endif
f_out = f_out*dX*dY*dZ
@@ -1769,12 +1808,23 @@ if(Symmetry==2)then
if(dabs(ymin+gw*dY)<dY.and.Y(1)<0.d0) jmin = gw+1
endif
#if USE_FMISC_SAFE_MODE
f_out = 0.d0
do k = kmin, kmax
do j = jmin, jmax
do i = imin, imax
f_out = f_out + f(i,j,k)*f(i,j,k)
end do
end do
end do
#else
! Optimized with oneMKL BLAS DDOT for dot product
Nout = (imax-imin+1)*(jmax-jmin+1)*(kmax-kmin+1)
allocate(f_flat(Nout))
f_flat = reshape(f(imin:imax,jmin:jmax,kmin:kmax), [Nout])
f_out = DDOT(Nout, f_flat, 1, f_flat, 1)
deallocate(f_flat)
Nout = (imax-imin+1)*(jmax-jmin+1)*(kmax-kmin+1)
allocate(f_flat(Nout))
f_flat = reshape(f(imin:imax,jmin:jmax,kmin:kmax), [Nout])
f_out = DDOT(Nout, f_flat, 1, f_flat, 1)
deallocate(f_flat)
#endif
return
@@ -1878,9 +1928,19 @@ deallocate(f_flat)
real*8,parameter::C1=3.d0/8.d0,C2=3.d0/4.d0,C3=-1.d0/8.d0
integer :: i,j,k
#if USE_FMISC_SAFE_MODE
do k=1,ext(3)
do j=1,ext(2)
do i=1,ext(1)
fout(i,j,k) = C1*f1(i,j,k)+C2*f2(i,j,k)+C3*f3(i,j,k)
enddo
enddo
enddo
#else
do concurrent (k=1:ext(3), j=1:ext(2), i=1:ext(1))
fout(i,j,k) = C1*f1(i,j,k)+C2*f2(i,j,k)+C3*f3(i,j,k)
end do
#endif
return
@@ -2024,8 +2084,15 @@ deallocate(f_flat)
tmp1 = tmp1 + coef(ORDN+m)*tmp2(:,m)
enddo
#if USE_FMISC_SAFE_MODE
f_int = 0.d0
do m = 1, ORDN
f_int = f_int + coef(m) * tmp1(m)
end do
#else
! Third dimension: x-direction weighted sum using BLAS DDOT
f_int = DDOT(ORDN, coef(1:ORDN), 1, tmp1, 1)
#endif
return
@@ -2091,8 +2158,15 @@ deallocate(f_flat)
tmp1 = tmp1 + coef(ORDN+m)*ya(:,m)
enddo
#if USE_FMISC_SAFE_MODE
f_int = 0.d0
do m = 1, ORDN
f_int = f_int + coef(m) * tmp1(m)
end do
#else
! Use BLAS DDOT for final weighted sum
f_int = DDOT(ORDN, coef(1:ORDN), 1, tmp1, 1)
#endif
return
@@ -2184,8 +2258,15 @@ deallocate(f_flat)
write(*,*)"error in global_interpind1d, not recognized dumyd = ",dumyd
endif
#if USE_FMISC_SAFE_MODE
f_int = 0.d0
do m = 1, ORDN
f_int = f_int + coef(m) * ya(m)
end do
#else
! Optimized with BLAS DDOT for weighted sum
f_int = DDOT(ORDN, coef, 1, ya, 1)
#endif
return

9
AMSS_NCKU_source/makefile
View File

@@ -55,6 +55,7 @@ EM_KERNEL_FLAG = -DBSSN_USE_EM_C_KERNEL=$(EFFECTIVE_USE_CXX_EM_KERNEL)
## 0 : fallback to Neville path
POLINT6_USE_BARY ?= 1
POLINT6_FLAG = -DPOLINT6_USE_BARYCENTRIC=$(POLINT6_USE_BARY)
FMISC_SAFE_FLAG = -DUSE_FMISC_SAFE_MODE=$(USE_FMISC_SAFE_MODE)
TRANSFER_CACHE_FLAG = -DBSSN_USE_TRANSFER_CACHE=$(EFFECTIVE_USE_TRANSFER_CACHE)
ESCALAR_KERNEL_FLAG = -DBSSN_USE_ESCALAR_C_KERNEL=$(EFFECTIVE_USE_CXX_ESCALAR_KERNEL)
@@ -67,9 +68,11 @@ ifeq ($(PGO_MODE),instrument)
## Phase 1: instrumentation — omit -ipo/-fp-model fast=2 for faster build and numerical stability
CXXAPPFLAGS = -O3 -march=x86-64-v4 -fma -fprofile-instr-generate -ipo \
-Dfortran3 -Dnewc -I${MKLROOT}/include $(INTERP_LB_FLAGS) \
$(FMISC_SAFE_FLAG) \
$(TRANSFER_CACHE_FLAG) $(ESCALAR_KERNEL_FLAG) $(EM_KERNEL_FLAG)
f90appflags = -O3 -march=x86-64-v4 -fma -fprofile-instr-generate -ipo \
-align array64byte -fpp -I${MKLROOT}/include $(POLINT6_FLAG)
-align array64byte -fpp -I${MKLROOT}/include $(POLINT6_FLAG) \
$(FMISC_SAFE_FLAG)
else
## opt (default): maximum performance with PGO profile data -fprofile-instr-use=$(PROFDATA) \
## PGO has been turned off, now tested and found to be negative optimization
@@ -78,9 +81,11 @@ else
CXXAPPFLAGS = -O3 -march=x86-64-v4 -fp-model fast=2 -fma -ipo \
-Dfortran3 -Dnewc -I${MKLROOT}/include $(INTERP_LB_FLAGS) \
$(FMISC_SAFE_FLAG) \
$(TRANSFER_CACHE_FLAG) $(ESCALAR_KERNEL_FLAG) $(EM_KERNEL_FLAG)
f90appflags = -O3 -march=x86-64-v4 -fp-model fast=2 -fma -ipo \
-align array64byte -fpp -I${MKLROOT}/include $(POLINT6_FLAG)
-align array64byte -fpp -I${MKLROOT}/include $(POLINT6_FLAG) \
$(FMISC_SAFE_FLAG)
endif
.SUFFIXES: .o .f90 .C .for .cu

5
AMSS_NCKU_source/makefile.inc
View File

@@ -76,6 +76,11 @@ USE_TRANSFER_CACHE ?= auto
## 0 (default): use original Fortran rungekutta4_rout.o
USE_CXX_RK4 ?= 0
## fmisc conservative mode switch
## 1 : restore lower-optimization / legacy fmisc numerics
## 0 (default): keep the optimized fmisc paths
USE_FMISC_SAFE_MODE ?= 0
f90 = ifx
f77 = ifx
CXX = icpx