Add conservative fmisc safe mode

2026-05-17 00:35:17 +08:00
parent 3806e82c47
commit 6f62e75245
3 changed files with 140 additions and 49 deletions
--- a/AMSS_NCKU_source/fmisc.f90
+++ b/AMSS_NCKU_source/fmisc.f90
@@ -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)
+#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)
+#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)
+#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

--- a/AMSS_NCKU_source/makefile
+++ b/AMSS_NCKU_source/makefile
@@ -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
--- a/AMSS_NCKU_source/makefile.inc
+++ b/AMSS_NCKU_source/makefile.inc
@@ -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