docs: 更新 examples/Readme.md 并新增 Readme.html
- 覆盖全部 10 个案例(原 Readme 只到 case06) - 新增案例选择指南表格 - Readme.html 为深色主题独立 HTML 页面 (含卡片布局、标签分类、代码高亮、响应式设计) - 各案例详情对齐最新配置参数
This commit is contained in:
@@ -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
|
||||
@@ -0,0 +1 @@
|
||||
{"n_atoms": 40, "nt": 200000, "step_time": 0.005991018545627594}
|
||||
@@ -0,0 +1,483 @@
|
||||
! engines/fortran/dynamics_lib.f90
|
||||
! ---------------------------------
|
||||
! 纯计算 DLL(Fortran 版):无文件 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_dynamics(C 兼容接口,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
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user