% test
% 以希爾伯特矩陣測試
clear; clc;
dt = 1e-8;
A = hilb(12); % 條件數:1.6211639047475e+16
x0 = ones(12,1);
b = A*x0;
n = size(b,1);
H = -A;
Ta = H*dt + (H*dt)^2/2 + (H*dt)^3/6; % Ta(0)
F = dt * ( eye(n,n) + H*dt/2 + (H*dt)^2/6 + (H*dt)^3/24 ); % F(Δt)
x = F * b; % x0
for i = 1 : 40
Ta = 2*Ta + Ta*Ta;
T = eye(n,n) + Ta;
x = ( eye(n,n) + T ) * x;
end
x = 2*x;
% 比較x和x0的差異
program main
implicit none
integer :: i, j
integer, parameter :: m = 4
real*8, parameter :: dt = 1d-8
real*8 :: A(m,m)
real*8 :: x(m), b(m)
real*8 :: F(m,m), T(m,m), eye(m,m)
A = reshape( [5.d0, 7.d0, 6.d0, 5.d0, &
7.d0, 10.d0, 8.d0, 7.d0, &
6.d0, 8.d0, 10.d0, 9.d0, &
5.d0, 7.d0, 9.d0, 10.d0], shape(A) )
A = -A
b = [23.d0, 32.d0, 33.d0, 31.d0]
F = 0.d0; T = 0.d0
call getFT( A, dt, F, T, m ) !// F0, T0
x = matmul( F, b ) !// x0
print*, x
do i = 1, m
write(*,'(*(es20.7))') T(i,:)
end do
forall( i = 1:m ) eye(i,i) = 1.d0
do i = 1, 100
T = 2.d0 * T + matmul(T,T)
x = matmul( (eye + (eye + T)), x )
write(*,'(*(g0,3x))') 2.d0 * x
end do
end program main
subroutine getFT( B, dt, F, T, m )
implicit none
integer :: i, m, n
real*8 :: dt, B(m,m), F(m,m), T(m,m), eye(m,m), temp(m,m)
eye = 0.d0
forall( i = 1: m ) eye(i,i) = 1.d0
n = 1
temp = dt * B
F = eye
do i = 2, 4
n = i * n
F = F + temp / real(n,8)
temp = matmul( temp, dt*B )
end do
F = dt * F
!// T0
n = 1
temp = dt * B
T = 0.d0
do i = 1, 3
n = i * n
T = T + temp / real(n,8)
temp = matmul( temp, dt*B )
end do
end subroutine getFT
!program main
! implicit none
! integer :: i, j
! integer, parameter :: m = 4
! real*8, parameter :: dt = 1d-6
! real*8 :: A(m,m), BB(m,m), Q(m,m), P(m,m)
! real*8 :: x(m), y(m), b0(m), b(m)
! real*8 :: F(m,m), T(m,m), eye(m,m)
!
! A = reshape( [5.d0, 7.d0, 6.d0, 5.d0, &
! 7.d0, 10.d0, 8.d0, 7.d0, &
! 6.d0, 8.d0, 10.d0, 9.d0, &
! 5.d0, 7.d0, 9.d0, 10.d0], shape(A) )
!
! b0 = [57.d0, 79.d0, 88.d0, 86.d0] !// 精確解:[1;2;3;4]
!
! eye = 0.d0
! forall( i = 1: m ) eye(i,i) = 1.d0
!
! Q = 0.d0
! forall( i = 1: m ) Q(i,i) = 1.d0 / sum(abs(A(i,:)))
!
! BB = matmul( Q, A )
!
! P = 0.d0
! forall( i = 1: m ) P(i,i) = 1.d0 / sum(abs(BB(:,i)))
!
! BB = matmul( BB, P )
!
! b = matmul( Q, b0 )
! F = 0.d0; T = 0.d0
! call getFT( BB, dt, F, T, m ) !// F0, T0
!
! y = matmul( F, b ) !// y0
! x = matmul( P, y ) !// x0
!
! do i = 1, 64
!
! T = 2.d0 * T + matmul(T,T)
! y = matmul( ((eye + (eye + T))), y )
! x = matmul( P, y )
! write(*,'(*(g0,3x))') 2.d0 * x
! end do
!
!end program main
!
!
!subroutine getFT( B, dt, F, T, m )
! implicit none
! integer :: i, m, n
! real*8 :: dt, B(m,m), F(m,m), T(m,m), eye(m,m), temp(m,m)
!
! eye = 0.d0
! forall( i = 1: m ) eye(i,i) = 1.d0
!
! n = 1
! temp = -1.d0 * dt * B
! F = eye
! do i = 2, 4
!
! n = i * n
! F = F + temp / real(n,8)
! temp = matmul( temp, -1.d0*dt*B )
!
! end do
!
! F = dt * F
!
! !// T0
! n = 1
! temp = -1.d0 * dt * B
! T = 0.d0
!
! do i = 1, 3
!
! n = i * n
! T = T + temp / real(n,8)
! temp = matmul( temp, -1.d0*dt*B )
!
! end do
!
!
!end subroutine getFT
