docs: 更新 examples/Readme.md 并新增 Readme.html

- 覆盖全部 10 个案例(原 Readme 只到 case06)
- 新增案例选择指南表格
- Readme.html 为深色主题独立 HTML 页面
  (含卡片布局、标签分类、代码高亮、响应式设计)
- 各案例详情对齐最新配置参数
This commit is contained in:
2026-06-17 15:33:49 +08:00
parent ea99f09f9b
commit 0e636e275d
59 changed files with 7302 additions and 418 deletions
+47
View File
@@ -0,0 +1,47 @@
# engines/fortran/Makefile
FC = gfortran
FFLAGS = -O3 -march=native -Wall -Wextra
SRCS = main.f90
LIB_SRC = dynamics_lib.f90
UNAME_S := $(shell uname -s 2>/dev/null || echo Windows)
ifeq ($(UNAME_S),Windows)
STATIC_FLAGS = -static-libgcc -static-libgfortran -static-libquadmath
else
STATIC_FLAGS =
endif
TARGET = build/dynamics_f90.exe
ifeq ($(UNAME_S),Linux)
DLL_TARGET = build/dynamics_f90.so
DLL_FLAGS = -shared -fPIC
else ifeq ($(UNAME_S),Darwin)
DLL_TARGET = build/dynamics_f90.dylib
DLL_FLAGS = -dynamiclib
else
DLL_TARGET = build/dynamics_f90.dll
DLL_FLAGS = -shared -fPIC
endif
.PHONY: all dll clean
all: $(TARGET)
dll: $(DLL_TARGET)
$(TARGET): $(SRCS) | build
$(FC) $(FFLAGS) $(STATIC_FLAGS) -o $@ $(SRCS)
@echo " === Fortran engine built: $@ ==="
$(DLL_TARGET): $(LIB_SRC) | build
$(FC) $(FFLAGS) $(STATIC_FLAGS) $(DLL_FLAGS) -o $@ $(LIB_SRC)
@echo " === Fortran DLL built: $@ ==="
build:
mkdir -p build
clean:
rm -rf build *.o *.mod
+1
View File
@@ -0,0 +1 @@
{"n_atoms": 40, "nt": 200000, "step_time": 0.005991018545627594}
+483
View File
@@ -0,0 +1,483 @@
! engines/fortran/dynamics_lib.f90
! ---------------------------------
! 纯计算 DLLFortran 版):无文件 I/O,由 Python ctypes 调用。
! 算法与 main.f90 / compute.py 完全一致。
! 使用 iso_c_binding 导出 C 兼容接口。
!
! 编译(Windows:
! gfortran -O3 -march=native -shared -fPIC -o build/dynamics_f90.dll dynamics_lib.f90
! 编译(Linux:
! gfortran -O3 -march=native -shared -fPIC -o build/dynamics_f90.so dynamics_lib.f90
! 编译(macOS:
! gfortran -O3 -march=native -dynamiclib -o build/dynamics_f90.dylib dynamics_lib.f90
module dynamics_dll
use iso_c_binding, only: c_int, c_double, c_funptr, c_f_procpointer, c_associated
implicit none
private
real(c_double), parameter :: TWO_PI = 2.0d0 * 3.14159265358979323846d0
public :: run_dynamics
contains
! ── 保守加速度 ───────────────────────────────────────────────
subroutine accel_conservative(n, x, y, z, m, Gx, Gy, Gz, &
gravity_field, elastic_force, &
n_bonds, bond_pairs, bond_k, bond_r0, &
ax, ay, az)
integer, intent(in) :: n, gravity_field, elastic_force, n_bonds
real(c_double), intent(in) :: x(n), y(n), z(n), m(n)
real(c_double), intent(in) :: Gx, Gy, Gz
integer, intent(in) :: bond_pairs(2, n_bonds)
real(c_double), intent(in) :: bond_k(n_bonds), bond_r0(n_bonds)
real(c_double), intent(out) :: ax(n), ay(n), az(n)
integer :: b, ii, jj
real(c_double) :: dx, dy, dz, dist, fac, fx, fy, fz_b
if (gravity_field /= 0) then
ax = Gx; ay = Gy; az = Gz
else
ax = 0.0d0; ay = 0.0d0; az = 0.0d0
end if
if (elastic_force == 0 .or. n_bonds == 0) return
do b = 1, n_bonds
ii = bond_pairs(1, b) + 1 ! 0-based → 1-based
jj = bond_pairs(2, b) + 1
dx = x(jj)-x(ii); dy = y(jj)-y(ii); dz = z(jj)-z(ii)
dist = sqrt(dx*dx + dy*dy + dz*dz)
if (dist < 1.0d-12) cycle
fac = bond_k(b) * (dist - bond_r0(b)) / dist
fx = fac*dx; fy = fac*dy; fz_b = fac*dz
ax(ii) = ax(ii) + fx/m(ii); ay(ii) = ay(ii) + fy/m(ii); az(ii) = az(ii) + fz_b/m(ii)
ax(jj) = ax(jj) - fx/m(jj); ay(jj) = ay(jj) - fy/m(jj); az(jj) = az(jj) - fz_b/m(jj)
end do
end subroutine
! ── 完整加速度(含阻尼)──────────────────────────────────────
subroutine accel_full(n, x, y, z, vx, vy, vz, m, Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax, ay, az)
integer, intent(in) :: n, gravity_field, elastic_force, damping_force, n_bonds
real(c_double), intent(in) :: x(n), y(n), z(n), vx(n), vy(n), vz(n), m(n)
real(c_double), intent(in) :: Gx, Gy, Gz, Bx, By, Bz
integer, intent(in) :: bond_pairs(2, n_bonds)
real(c_double), intent(in) :: bond_k(n_bonds), bond_r0(n_bonds)
real(c_double), intent(out) :: ax(n), ay(n), az(n)
integer :: i
call accel_conservative(n, x, y, z, m, Gx, Gy, Gz, &
gravity_field, elastic_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax, ay, az)
if (damping_force /= 0) then
do i = 1, n
ax(i) = ax(i) - Bx*vx(i)/m(i)
ay(i) = ay(i) - By*vy(i)/m(i)
az(i) = az(i) - Bz*vz(i)/m(i)
end do
end if
end subroutine
! ── 边界 + 固定约束 ──────────────────────────────────────────
subroutine apply_bc(n, x, y, z, vx, vy, vz, fixed, pos_init, box_a)
integer, intent(in) :: n
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
integer, intent(in) :: fixed(3, n)
real(c_double), intent(in) :: pos_init(3, n), box_a
integer :: i
real(c_double) :: lo, hi
lo = -box_a; hi = box_a
! 反弹
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) cycle
if (x(i)>hi) then; x(i)=hi; vx(i)=-abs(vx(i)); end if
if (x(i)<lo) then; x(i)=lo; vx(i)= abs(vx(i)); end if
if (y(i)>hi) then; y(i)=hi; vy(i)=-abs(vy(i)); end if
if (y(i)<lo) then; y(i)=lo; vy(i)= abs(vy(i)); end if
if (z(i)>hi) then; z(i)=hi; vz(i)=-abs(vz(i)); end if
if (z(i)<lo) then; z(i)=lo; vz(i)= abs(vz(i)); end if
end do
! 回绕
do i = 1, n
if (x(i)>hi) x(i)=lo; if (x(i)<lo) x(i)=hi
if (y(i)>hi) y(i)=lo; if (y(i)<lo) y(i)=hi
if (z(i)>hi) z(i)=lo; if (z(i)<lo) z(i)=hi
end do
! 逐自由度固定约束
do i = 1, n
if (fixed(1,i)/=0) then; x(i)=pos_init(1,i); vx(i)=0.0d0; end if
if (fixed(2,i)/=0) then; y(i)=pos_init(2,i); vy(i)=0.0d0; end if
if (fixed(3,i)/=0) then; z(i)=pos_init(3,i); vz(i)=0.0d0; end if
end do
end subroutine
! ── 蛙跳法 ───────────────────────────────────────────────────
subroutine leapfrog_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
integer, intent(in) :: n, gravity_field, elastic_force, damping_force, n_bonds
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
real(c_double), intent(in) :: m(n), bond_k(n_bonds), bond_r0(n_bonds)
integer, intent(in) :: fixed(3,n), bond_pairs(2,n_bonds)
real(c_double), intent(in) :: Gx, Gy, Gz, Bx, By, Bz, dt
real(c_double) :: ax(n), ay(n), az(n), ax_, ay_, az_
logical :: has_damp
integer :: i
call accel_conservative(n, x, y, z, m, Gx, Gy, Gz, &
gravity_field, elastic_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax, ay, az)
has_damp = (damping_force/=0) .and. (abs(Bx)+abs(By)+abs(Bz) > 0.0d0)
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) cycle
if (has_damp) then
ax_ = Bx*dt/(2.0d0*m(i)); ay_ = By*dt/(2.0d0*m(i)); az_ = Bz*dt/(2.0d0*m(i))
vx(i) = (vx(i)*(1.0d0-ax_) + ax(i)*dt)/(1.0d0+ax_)
vy(i) = (vy(i)*(1.0d0-ay_) + ay(i)*dt)/(1.0d0+ay_)
vz(i) = (vz(i)*(1.0d0-az_) + az(i)*dt)/(1.0d0+az_)
else
vx(i) = vx(i)+ax(i)*dt; vy(i) = vy(i)+ay(i)*dt; vz(i) = vz(i)+az(i)*dt
end if
x(i) = x(i)+vx(i)*dt; y(i) = y(i)+vy(i)*dt; z(i) = z(i)+vz(i)*dt
end do
end subroutine
! ── 显式欧拉法 ───────────────────────────────────────────────
subroutine euler_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
integer, intent(in) :: n, gravity_field, elastic_force, damping_force, n_bonds
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
real(c_double), intent(in) :: m(n), bond_k(n_bonds), bond_r0(n_bonds)
integer, intent(in) :: fixed(3,n), bond_pairs(2,n_bonds)
real(c_double), intent(in) :: Gx, Gy, Gz, Bx, By, Bz, dt
real(c_double) :: ax(n), ay(n), az(n)
integer :: i
call accel_full(n, x, y, z, vx, vy, vz, m, Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax, ay, az)
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) cycle
x(i) = x(i)+vx(i)*dt; y(i) = y(i)+vy(i)*dt; z(i) = z(i)+vz(i)*dt
vx(i)= vx(i)+ax(i)*dt; vy(i)= vy(i)+ay(i)*dt; vz(i)= vz(i)+az(i)*dt
end do
end subroutine
! ── 隐式欧拉法 ───────────────────────────────────────────────
subroutine implicit_euler_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
integer, intent(in) :: n, gravity_field, elastic_force, damping_force, n_bonds
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
real(c_double), intent(in) :: m(n), bond_k(n_bonds), bond_r0(n_bonds)
integer, intent(in) :: fixed(3,n), bond_pairs(2,n_bonds)
real(c_double), intent(in) :: Gx, Gy, Gz, Bx, By, Bz, dt
real(c_double) :: vxn(n), vyn(n), vzn(n), ax(n), ay(n), az(n)
real(c_double) :: gamma_x, gamma_y, gamma_z
integer :: i
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) then
vxn(i)=0.0d0; vyn(i)=0.0d0; vzn(i)=0.0d0; cycle
end if
gamma_x = Bx/m(i); gamma_y = By/m(i); gamma_z = Bz/m(i)
vxn(i) = (vx(i)+Gx*dt)/(1.0d0+gamma_x*dt)
vyn(i) = (vy(i)+Gy*dt)/(1.0d0+gamma_y*dt)
vzn(i) = (vz(i)+Gz*dt)/(1.0d0+gamma_z*dt)
end do
call accel_full(n, x, y, z, vxn, vyn, vzn, m, Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax, ay, az)
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) cycle
vx(i)=vx(i)+ax(i)*dt; vy(i)=vy(i)+ay(i)*dt; vz(i)=vz(i)+az(i)*dt
x(i) =x(i) +vx(i)*dt; y(i) =y(i) +vy(i)*dt; z(i) =z(i) +vz(i)*dt
end do
end subroutine
! ── 中点法 ───────────────────────────────────────────────────
subroutine midpoint_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
integer, intent(in) :: n, gravity_field, elastic_force, damping_force, n_bonds
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
real(c_double), intent(in) :: m(n), bond_k(n_bonds), bond_r0(n_bonds)
integer, intent(in) :: fixed(3,n), bond_pairs(2,n_bonds)
real(c_double), intent(in) :: Gx, Gy, Gz, Bx, By, Bz, dt
real(c_double) :: ax(n), ay(n), az(n)
real(c_double) :: xm(n), ym(n), zm(n), vxm(n), vym(n), vzm(n)
real(c_double) :: axm(n), aym(n), azm(n)
integer :: i
call accel_full(n, x, y, z, vx, vy, vz, m, Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax, ay, az)
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) then
xm(i)=x(i); ym(i)=y(i); zm(i)=z(i)
vxm(i)=0.0d0; vym(i)=0.0d0; vzm(i)=0.0d0; cycle
end if
xm(i) = x(i) +0.5d0*vx(i)*dt; ym(i) = y(i) +0.5d0*vy(i)*dt; zm(i) = z(i) +0.5d0*vz(i)*dt
vxm(i) = vx(i)+0.5d0*ax(i)*dt; vym(i) = vy(i)+0.5d0*ay(i)*dt; vzm(i) = vz(i)+0.5d0*az(i)*dt
x(i) = x(i) +vxm(i)*dt; y(i) = y(i) +vym(i)*dt; z(i) = z(i) +vzm(i)*dt
end do
call accel_full(n, xm, ym, zm, vxm, vym, vzm, m, Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, axm, aym, azm)
do i = 1, n
if (fixed(1,i)/=0 .and. fixed(2,i)/=0 .and. fixed(3,i)/=0) cycle
vx(i)=vx(i)+axm(i)*dt; vy(i)=vy(i)+aym(i)*dt; vz(i)=vz(i)+azm(i)*dt
end do
end subroutine
! ── 驱动力施加 ───────────────────────────────────────────────
subroutine apply_drive(n, x, y, z, vx, vy, vz, t, step, dt, &
nd, drv_idx, drv_amp, drv_freq, drv_phi, &
drv_eq, drv_ncycles, drv_has_period, freeze)
integer, intent(in) :: n, nd, step
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
real(c_double), intent(in) :: t, dt
integer, intent(in) :: drv_idx(nd), drv_has_period(nd)
real(c_double), intent(in) :: drv_amp(3,nd), drv_freq(3,nd)
real(c_double), intent(in) :: drv_phi(3,nd), drv_eq(3,nd)
real(c_double), intent(in) :: drv_ncycles(nd)
real(c_double), intent(inout) :: freeze(3,nd)
integer :: d, idx, ps
real(c_double) :: fx, fy, fz, mf, px, py, pz
do d = 1, nd
idx = drv_idx(d) + 1 ! 0-based → 1-based
fx = drv_freq(1,d); fy = drv_freq(2,d); fz = drv_freq(3,d)
if (drv_has_period(d) /= 0) then
mf = max(abs(fx), max(abs(fy), abs(fz)))
ps = 0
if (mf > 1.0d-12) ps = int(drv_ncycles(d)/mf/dt)
if (step > ps) then
x(idx)=freeze(1,d); y(idx)=freeze(2,d); z(idx)=freeze(3,d)
vx(idx)=0.0d0; vy(idx)=0.0d0; vz(idx)=0.0d0
cycle
end if
px = drv_eq(1,d)+drv_amp(1,d)*cos(TWO_PI*fx*t+drv_phi(1,d))
py = drv_eq(2,d)+drv_amp(2,d)*cos(TWO_PI*fy*t+drv_phi(2,d))
pz = drv_eq(3,d)+drv_amp(3,d)*cos(TWO_PI*fz*t+drv_phi(3,d))
if (step == ps) then
freeze(1,d)=px; freeze(2,d)=py; freeze(3,d)=pz
end if
end if
x(idx) = drv_eq(1,d)+drv_amp(1,d)*cos(TWO_PI*fx*t+drv_phi(1,d))
y(idx) = drv_eq(2,d)+drv_amp(2,d)*cos(TWO_PI*fy*t+drv_phi(2,d))
z(idx) = drv_eq(3,d)+drv_amp(3,d)*cos(TWO_PI*fz*t+drv_phi(3,d))
vx(idx) = -drv_amp(1,d)*TWO_PI*fx*sin(TWO_PI*fx*t+drv_phi(1,d))
vy(idx) = -drv_amp(2,d)*TWO_PI*fy*sin(TWO_PI*fy*t+drv_phi(2,d))
vz(idx) = -drv_amp(3,d)*TWO_PI*fz*sin(TWO_PI*fz*t+drv_phi(3,d))
end do
end subroutine
! ══════════════════════════════════════════════════════════════
! 导出函数:run_dynamicsC 兼容接口,bind(C)
! 接口与 C/C++ DLL 完全相同(扁平 C-contiguous 数组)。
! ══════════════════════════════════════════════════════════════
integer(c_int) function run_dynamics( &
n_atoms, pos_init, vel_init, masses, fixed, &
n_bonds, bond_pairs, bond_k, bond_r0, &
box_a, dt, NT, NSTEP, warmup_steps, method_id, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, gravity_strength, &
n_drivers, drv_idx, drv_amp, drv_freq, drv_phi, drv_eq, &
drv_ncycles, drv_has_period, &
n_frames, out_x, out_y, out_z, out_vx, out_vy, out_vz, &
progress_cb) &
bind(C, name="run_dynamics")
integer(c_int), value, intent(in) :: n_atoms, n_bonds, NT, NSTEP
integer(c_int), value, intent(in) :: warmup_steps, method_id
integer(c_int), value, intent(in) :: gravity_field, elastic_force, damping_force
integer(c_int), value, intent(in) :: n_drivers, n_frames
real(c_double), value, intent(in) :: box_a, dt
real(c_double), value, intent(in) :: Gx, Gy, Gz, Bx, By, Bz
real(c_double), value, intent(in) :: gravity_strength
! 扁平数组:Python 传入 C-contiguous int32/float64
! Fortran 以列优先解释,维度反转:(3,n) 对应 C 的 n×3
real(c_double), intent(in) :: pos_init(3, n_atoms)
real(c_double), intent(in) :: vel_init(3, n_atoms)
real(c_double), intent(in) :: masses(n_atoms)
integer(c_int), intent(in) :: fixed(3, n_atoms)
integer(c_int), intent(in) :: bond_pairs(2, n_bonds)
real(c_double), intent(in) :: bond_k(n_bonds), bond_r0(n_bonds)
integer(c_int), intent(in) :: drv_idx(n_drivers)
real(c_double), intent(in) :: drv_amp(3, n_drivers)
real(c_double), intent(in) :: drv_freq(3, n_drivers)
real(c_double), intent(in) :: drv_phi(3, n_drivers)
real(c_double), intent(in) :: drv_eq(3, n_drivers)
real(c_double), intent(in) :: drv_ncycles(n_drivers)
integer(c_int), intent(in) :: drv_has_period(n_drivers)
real(c_double), intent(out) :: out_x(n_atoms, n_frames)
real(c_double), intent(out) :: out_y(n_atoms, n_frames)
real(c_double), intent(out) :: out_z(n_atoms, n_frames)
real(c_double), intent(out) :: out_vx(n_atoms, n_frames)
real(c_double), intent(out) :: out_vy(n_atoms, n_frames)
real(c_double), intent(out) :: out_vz(n_atoms, n_frames)
type(c_funptr), value, intent(in) :: progress_cb
! 进度回调接口
abstract interface
subroutine cb_iface(step, total) bind(C)
use iso_c_binding
integer(c_int), value :: step, total
end subroutine
end interface
procedure(cb_iface), pointer :: cb_ptr
integer :: n, s, frame_idx, record_steps, prog_interval, nd
real(c_double) :: t, tw
real(c_double), allocatable :: x(:), y(:), z(:), vx(:), vy(:), vz(:)
real(c_double), allocatable :: ax0(:), ay0(:), az0(:)
real(c_double), allocatable :: freeze(:,:)
logical :: has_cb
n = n_atoms
nd = n_drivers
allocate(x(n), y(n), z(n), vx(n), vy(n), vz(n))
do s = 1, n
x(s) = pos_init(1,s); y(s) = pos_init(2,s); z(s) = pos_init(3,s)
vx(s) = vel_init(1,s); vy(s) = vel_init(2,s); vz(s) = vel_init(3,s)
end do
allocate(freeze(3, max(nd,1)))
freeze = 0.0d0
has_cb = c_associated(progress_cb)
if (has_cb) call c_f_procpointer(progress_cb, cb_ptr)
! ── 蛙跳法:初始化 v(-dt/2) ─────────────────────────────
if (method_id == 3) then
allocate(ax0(n), ay0(n), az0(n))
call accel_conservative(n, x, y, z, masses, Gx, Gy, Gz, &
gravity_field, elastic_force, &
n_bonds, bond_pairs, bond_k, bond_r0, ax0, ay0, az0)
do s = 1, n
if (fixed(1,s)/=0 .and. fixed(2,s)/=0 .and. fixed(3,s)/=0) cycle
vx(s)=vx(s)-0.5d0*ax0(s)*dt
vy(s)=vy(s)-0.5d0*ay0(s)*dt
vz(s)=vz(s)-0.5d0*az0(s)*dt
end do
deallocate(ax0, ay0, az0)
end if
! ── 初始驱动 t=0 ─────────────────────────────────────────
if (nd > 0) call apply_drive(n, x, y, z, vx, vy, vz, 0.0d0, 0, dt, &
nd, drv_idx, drv_amp, drv_freq, drv_phi, &
drv_eq, drv_ncycles, drv_has_period, freeze)
! ── 预热 ─────────────────────────────────────────────────
do s = 0, warmup_steps-1
tw = (s+1)*dt
if (nd>0) call apply_drive(n, x, y, z, vx, vy, vz, tw, s, dt, &
nd, drv_idx, drv_amp, drv_freq, drv_phi, &
drv_eq, drv_ncycles, drv_has_period, freeze)
call do_step(n, x, y, z, vx, vy, vz, masses, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt, method_id, &
pos_init, box_a)
end do
! ── 记录循环 ─────────────────────────────────────────────
record_steps = NT - warmup_steps
prog_interval = max(1, record_steps/100)
frame_idx = 0
do s = 0, record_steps-1
if (has_cb .and. mod(s, prog_interval)==0 .and. s>0) call cb_ptr(s, record_steps)
t = (s+warmup_steps)*dt
if (nd>0) call apply_drive(n, x, y, z, vx, vy, vz, t, s, dt, &
nd, drv_idx, drv_amp, drv_freq, drv_phi, &
drv_eq, drv_ncycles, drv_has_period, freeze)
if (mod(s, NSTEP)==0 .and. frame_idx<n_frames) then
frame_idx = frame_idx+1
out_x(:, frame_idx) = x
out_y(:, frame_idx) = y
out_z(:, frame_idx) = z
out_vx(:, frame_idx) = vx
out_vy(:, frame_idx) = vy
out_vz(:, frame_idx) = vz
end if
call do_step(n, x, y, z, vx, vy, vz, masses, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt, method_id, &
pos_init, box_a)
end do
deallocate(x, y, z, vx, vy, vz, freeze)
run_dynamics = 0
contains
subroutine do_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt, method_id, &
pos_init, box_a)
integer, intent(in) :: n, gravity_field, elastic_force, damping_force
integer, intent(in) :: n_bonds, method_id
real(c_double), intent(inout) :: x(n), y(n), z(n), vx(n), vy(n), vz(n)
real(c_double), intent(in) :: m(n), bond_k(n_bonds), bond_r0(n_bonds)
integer, intent(in) :: fixed(3,n), bond_pairs(2,n_bonds)
real(c_double), intent(in) :: Gx, Gy, Gz, Bx, By, Bz, dt, box_a
real(c_double), intent(in) :: pos_init(3, n)
select case (method_id)
case (0)
call euler_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
case (1)
call implicit_euler_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
case (2)
call midpoint_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
case default
call leapfrog_step(n, x, y, z, vx, vy, vz, m, fixed, &
Gx, Gy, Gz, Bx, By, Bz, &
gravity_field, elastic_force, damping_force, &
n_bonds, bond_pairs, bond_k, bond_r0, dt)
end select
call apply_bc(n, x, y, z, vx, vy, vz, fixed, pos_init, box_a)
end subroutine do_step
end function run_dynamics
end module dynamics_dll
+82 -174
View File
@@ -49,7 +49,7 @@ program dynamics_f90
double precision, allocatable :: vx(:), vy(:), vz(:)
! 轨迹缓冲区
integer :: record_steps
integer :: record_steps, n_frames, frame_idx
double precision, allocatable :: traj_x(:, :), traj_y(:, :), traj_z(:, :)
double precision, allocatable :: traj_vx(:, :), traj_vy(:, :), traj_vz(:, :)
@@ -104,10 +104,11 @@ program dynamics_f90
vx(i) = vel_0(i, 1); vy(i) = vel_0(i, 2); vz(i) = vel_0(i, 3)
end do
! 分配轨迹缓冲区
! 分配轨迹缓冲区(只保存采样帧,不保存每一步)
record_steps = NT - warmup_steps
allocate(traj_x(record_steps, n), traj_y(record_steps, n), traj_z(record_steps, n))
allocate(traj_vx(record_steps, n), traj_vy(record_steps, n), traj_vz(record_steps, n))
n_frames = max(1, record_steps / max(1, NSTEP))
allocate(traj_x(n_frames, n), traj_y(n_frames, n), traj_z(n_frames, n))
allocate(traj_vx(n_frames, n), traj_vy(n_frames, n), traj_vz(n_frames, n))
! 真蛙跳初始化:v(0) 反推 v(-dt/2) = v(0) - 0.5*a_c(0)*dt
if (trim(method) == 'leapfrog') then
@@ -160,12 +161,19 @@ program dynamics_f90
pos_0)
end do
! 记录
prog_step = record_steps / 100
if (prog_step < 1) prog_step = 1
! 记录(每 NSTEP 步采一帧)
prog_step = max(1, record_steps / 100)
frame_idx = 0
do s = 1, record_steps
if (mod(s, prog_step) == 0 .and. s > 0) then
if (mod(s, prog_step) == 0) then
write(*, '("[Fortran-engine] progress: ", i0, "/", i0)') s, record_steps
flush(6)
end if
! 采帧:在每个 NSTEP 区间的起始时刻记录
if (mod(s-1, max(1, NSTEP)) == 0 .and. frame_idx < n_frames) then
frame_idx = frame_idx + 1
traj_x(frame_idx, :) = x; traj_y(frame_idx, :) = y; traj_z(frame_idx, :) = z
traj_vx(frame_idx, :) = vx; traj_vy(frame_idx, :) = vy; traj_vz(frame_idx, :) = vz
end if
if (driving_force /= 0 .and. n_drivers > 0) then
tw = ((s-1 + warmup_steps) * 1.0d0) * DT
@@ -178,8 +186,6 @@ program dynamics_f90
drv_eq_x, drv_eq_y, drv_eq_z, &
drv_freeze_x, drv_freeze_y, drv_freeze_z)
end if
traj_x(s, :) = x; traj_y(s, :) = y; traj_z(s, :) = z
traj_vx(s, :) = vx; traj_vy(s, :) = vy; traj_vz(s, :) = vz
call apply_step(method, n, x, y, z, vx, vy, vz, masses, G, B, &
n_bonds, bond_pairs, bond_stiffness, bond_rest_lengths, &
fixed, box_a, DT, &
@@ -188,13 +194,14 @@ program dynamics_f90
pos_0)
end do
! 输出轨迹
write(*, '("[Fortran-engine] 正在写入轨迹数据…")')
call write_json(output_dir, traj_x, traj_y, traj_z, traj_vx, traj_vy, traj_vz, &
record_steps, n_atoms, atom_ids, masses, &
NT, DT, NSTEP, warmup_steps, method, G, B, &
n_bonds, bond_pairs, bond_stiffness, bond_rest_lengths, &
driving_force)
! 输出 display.txt
write(*, '("[Fortran-engine] 正在写入 display.txt (", i0, " 帧)…")') n_frames
flush(6)
call write_display_txt(output_dir, n_frames, n_atoms, atom_ids, &
traj_x, traj_y, traj_z, traj_vx, traj_vy, traj_vz, &
NT, DT, NSTEP, warmup_steps, method, G, B, &
n_bonds, gravity_field, elastic_force, damping_force, &
driving_force, box_a, gravity_strength)
call cpu_time(t1)
elapsed = t1 - t0
@@ -985,179 +992,80 @@ subroutine apply_driving(n, x, y, z, vx, vy, vz, t, step, dt, &
end subroutine apply_driving
! ========================================================================
! JSON 输出
! display.txt 输出(与 compute.py save_display_txt 格式一致)
! ========================================================================
subroutine write_json(outdir, tx, ty, tz, tvx, tvy, tvz, &
nsteps, nat, aid, amass, &
NT, DT, NSTEP, warmup, method, G, B, &
nb, bp, bk, br, driving_force)
subroutine write_display_txt(outdir, n_frames, nat, aid, &
tx, ty, tz, tvx, tvy, tvz, &
NT, DT, NSTEP, warmup, method, G, B, &
nb, gravity_field, elastic_force, damping_force, &
driving_force, box_a, gravity_strength)
character(len=*), intent(in) :: outdir, method
integer, intent(in) :: nsteps, nat, NT, NSTEP, warmup, nb, bp(nb, 2), aid(nat), driving_force
double precision, intent(in) :: tx(nsteps, nat), ty(nsteps, nat), tz(nsteps, nat)
double precision, intent(in) :: tvx(nsteps, nat), tvy(nsteps, nat), tvz(nsteps, nat)
double precision, intent(in) :: DT, G(3), B(3), bk(nb), br(nb), amass(nat)
integer, intent(in) :: n_frames, nat, NT, NSTEP, warmup, nb
integer, intent(in) :: gravity_field, elastic_force, damping_force, driving_force
integer, intent(in) :: aid(nat)
double precision, intent(in) :: tx(n_frames, nat), ty(n_frames, nat), tz(n_frames, nat)
double precision, intent(in) :: tvx(n_frames, nat), tvy(n_frames, nat), tvz(n_frames, nat)
double precision, intent(in) :: DT, G(3), B(3), box_a, gravity_strength
character(len=512) :: path, buf
integer :: u, s, i, ib, ios
integer :: u, f, a, ios
integer :: dynamic_steps
double precision :: T_total
path = trim(outdir) // '/trajectory.txt'
dynamic_steps = NT - warmup
T_total = NT * DT
path = trim(outdir) // '/display.txt'
open(newunit=u, file=trim(path), status='replace', action='write', iostat=ios)
if (ios /= 0) then
write(*, '("[Fortran-engine] 错误: 无法写入 ", a)') trim(path)
stop
return
end if
write(u, '(a)') '{'
! traj_x
write(u, '(a)') ' "traj_x": ['
do s = 1, nsteps
call json_arr(u, tx(s, :), nat, s < nsteps, ' ')
end do
write(u, '(a)') ' ],'
! traj_y
write(u, '(a)') ' "traj_y": ['
do s = 1, nsteps
call json_arr(u, ty(s, :), nat, s < nsteps, ' ')
end do
write(u, '(a)') ' ],'
! traj_z
write(u, '(a)') ' "traj_z": ['
do s = 1, nsteps
call json_arr(u, tz(s, :), nat, s < nsteps, ' ')
end do
write(u, '(a)') ' ],'
! traj_vx
write(u, '(a)') ' "traj_vx": ['
do s = 1, nsteps
call json_arr(u, tvx(s, :), nat, s < nsteps, ' ')
end do
write(u, '(a)') ' ],'
! traj_vy
write(u, '(a)') ' "traj_vy": ['
do s = 1, nsteps
call json_arr(u, tvy(s, :), nat, s < nsteps, ' ')
end do
write(u, '(a)') ' ],'
! traj_vz
write(u, '(a)') ' "traj_vz": ['
do s = 1, nsteps
call json_arr(u, tvz(s, :), nat, s < nsteps, ' ')
end do
write(u, '(a)') ' ],'
! 标量参数
write(buf, '(a, i0, a)') ' "NT": ', NT, ','
! ── header ────────────────────────────────────────────────────────────
write(u, '("number of frames: ", i0)') n_frames
write(u, '("number of particles: ", i0)') nat
write(u, '("DT: ", g0)') DT
write(u, '("NSTEP: ", i0)') NSTEP
write(u, '("method: ", a)') trim(method)
write(u, '("NT: ", i0)') NT
write(u, '("warmup_steps: ", i0)') warmup
write(u, '("dynamic_steps: ", i0)') dynamic_steps
write(u, '("T_total: ", g0)') T_total
write(u, '("box_a: ", g0)') box_a
write(u, '("gravity_field: ", i0)') gravity_field
write(u, '("elastic_force: ", i0)') elastic_force
write(u, '("damping_force: ", i0)') damping_force
write(u, '("driving_force: ", i0)') driving_force
write(u, '("gravity_strength: ", g0)') gravity_strength
write(buf, '("G: [", g0, ", ", g0, ", ", g0, "]")') G(1), G(2), G(3)
write(u, '(a)') trim(buf)
write(buf, '(a, g0, a)') ' "DT": ', DT, ','
write(u, '(a)') trim(buf)
write(buf, '(a, i0, a)') ' "NSTEP": ', NSTEP, ','
write(u, '(a)') trim(buf)
write(buf, '(a, a, a)') ' "method": "', trim(method), '",'
write(u, '(a)') trim(buf)
write(buf, '(a, i0, a)') ' "warmup_steps": ', warmup, ','
write(buf, '("B: [", g0, ", ", g0, ", ", g0, "]")') B(1), B(2), B(3)
write(u, '(a)') trim(buf)
write(u, '("number_of_frames: ", i0)') n_frames
write(u, '("number_of_particles: ", i0)') nat
write(buf, '("X_MIN: ", g0)') -box_a; write(u, '(a)') trim(buf)
write(buf, '("X_MAX: ", g0)') box_a; write(u, '(a)') trim(buf)
write(buf, '("Y_MIN: ", g0)') -box_a; write(u, '(a)') trim(buf)
write(buf, '("Y_MAX: ", g0)') box_a; write(u, '(a)') trim(buf)
write(buf, '("Z_MIN: ", g0)') -box_a; write(u, '(a)') trim(buf)
write(buf, '("Z_MAX: ", g0)') box_a; write(u, '(a)') trim(buf)
write(buf, '(a, g0, a, g0, a, g0, a)') &
' "G": [', G(1), ', ', G(2), ', ', G(3), '],'
write(u, '(a)') trim(buf)
write(buf, '(a, g0, a, g0, a, g0, a)') &
' "B": [', B(1), ', ', B(2), ', ', B(3), '],'
write(u, '(a)') trim(buf)
! 原子信息
write(u, '(a)', advance='no') ' "atom_ids": ['
do i = 1, nat
if (i > 1) write(u, '(a)', advance='no') ','
write(u, '(i0)', advance='no') aid(i)
! ── frame data ────────────────────────────────────────────────────────
do f = 1, n_frames
write(u, '()') ! 空行
write(u, '("frame: ", i0)') f
write(u, '("n x y z vx vy vz")')
do a = 1, nat
write(u, '(i0, 6(f13.6))') aid(a), &
tx(f,a), ty(f,a), tz(f,a), tvx(f,a), tvy(f,a), tvz(f,a)
end do
end do
write(u, '(a)') '],'
write(u, '(a)', advance='no') ' "atom_masses": ['
do i = 1, nat
if (i > 1) write(u, '(a)', advance='no') ','
write(u, '(g0)', advance='no') amass(i)
end do
write(u, '(a)') '],'
! 成键
if (nb > 0) then
call write_int2_arr(u, 'bond_pairs', bp, nb, .true.)
call write_dbl_arr(u, 'bond_stiffness', bk, nb, .true.)
call write_dbl_arr(u, 'bond_rest_lengths', br, nb, .true.)
else
write(u, '(a)') ' "bond_pairs": [],'
write(u, '(a)') ' "bond_stiffness": [],'
write(u, '(a)') ' "bond_rest_lengths": [],'
end if
write(buf, '(a, i0)') ' "driving_force": ', driving_force
write(u, '(a)') trim(buf)
write(u, '(a)') '}'
close(u)
end subroutine write_json
! 写出单行 JSON 数组 [v1, v2, ...]
subroutine json_arr(u, vals, n, has_next, indent)
integer, intent(in) :: u, n
double precision, intent(in) :: vals(n)
logical, intent(in) :: has_next
character(len=*), intent(in) :: indent
integer :: i
write(u, '(a)', advance='no') indent // '['
do i = 1, n
if (i > 1) write(u, '(a)', advance='no') ','
write(u, '(g0.8)', advance='no') vals(i)
end do
if (has_next) then
write(u, '(a)') '],'
else
write(u, '(a)') ']'
end if
end subroutine json_arr
subroutine write_int2_arr(u, name, arr, n, has_next)
integer, intent(in) :: u, n, arr(n, 2)
character(len=*), intent(in) :: name
logical, intent(in) :: has_next
character(len=65536) :: buf
integer :: i, pos
write(u, '(a)', advance='no') ' "' // trim(name) // '": ['
do i = 1, n
if (i > 1) write(u, '(a)', advance='no') ','
write(buf, '(a, i0, a, i0, a)') '[', arr(i, 1), ',', arr(i, 2), ']'
write(u, '(a)', advance='no') trim(buf)
end do
if (has_next) then
write(u, '(a)') '],'
else
write(u, '(a)') ']'
end if
end subroutine write_int2_arr
subroutine write_dbl_arr(u, name, arr, n, has_next)
integer, intent(in) :: u, n
double precision, intent(in) :: arr(n)
character(len=*), intent(in) :: name
logical, intent(in) :: has_next
integer :: i
write(u, '(a)', advance='no') ' "' // trim(name) // '": ['
do i = 1, n
if (i > 1) write(u, '(a)', advance='no') ','
write(u, '(g0.8)', advance='no') arr(i)
end do
if (has_next) then
write(u, '(a)') '],'
else
write(u, '(a)') ']'
end if
end subroutine write_dbl_arr
write(*, '("[Fortran-engine] display.txt 已保存: ", a)') trim(path)
flush(6)
end subroutine write_display_txt
end program dynamics_f90