📄 errors_prb.f90
字号:
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Use a minimizer to seek the minimum |'
write ( *, '(a)' ) '| value of P(X) in (0.56, 0.59). |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) ' '
a = 0.56E+00
b = 0.59E+00
r1 = fmin ( a, b, freg11, tol )
f1 = freg11 ( r1 )
r2 = fmin ( a, b, fhorn11, tol )
f2 = fhorn11 ( r2 )
write ( *, '(a)' ) ' Using standard evaluation,'
write ( *, '(a,g18.10)' ) ' subroutine FMIN finds a minimizer at X = ', r1
write ( *, '(a,g18.10)' ) ' with function value P(X) = ', f1
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' Using Horner''s rule,'
write ( *, '(a,g18.10)' ) ' subroutine FMIN finds a minimizer at X = ', r2
write ( *, '(a,g18.10)' ) ' with function value P(X) = ', f2
return
end
subroutine test12
!
!*******************************************************************************
!
!! TEST12
!
implicit none
!
integer, parameter :: n = 9
integer, parameter :: lda = n
!
real a(lda,n)
real ab(n)
integer i
integer info
integer ipivot(n)
integer j
integer job
integer lcm_12n
integer mult
real qraux(n)
real qty(n)
real qy(n)
real r1(n)
real r2(n)
real rsd(n)
real work(n)
!
write ( *, '(a)' ) ' '
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Exercise 12 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Solve a linear system A * x = b |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| A is the Hilbert matrix of order 9, |'
write ( *, '(a)' ) '| multiplied by the least common multiple of |'
write ( *, '(a)' ) '| 1 through 9, so all entries are integers. |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| B = (1,0,0,...,0) |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| We are interested in the first component |'
write ( *, '(a)' ) '| X(1) of the solution vector. |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Correct X(1): |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| 6.611036022800E-06 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' R1: Gauss elimination using SGEFA and SGESL'
write ( *, '(a)' ) ' R2: QR factorization using SQRDC and SQRSL.'
write ( *, '(a)' ) ' '
mult = lcm_12n ( n )
do i = 1, n
do j = 1, n
a(i,j) = real ( mult ) / real ( i + j - 1 )
end do
end do
r1(1) = 1.0E+00
r1(2:n) = 0.0E+00
call sgefa ( a, lda, n, ipivot, info )
if ( info == 0 ) then
job = 0
call sgesl ( a, lda, n, ipivot, r1, job )
else
write ( *, '(a,i4)' ) ' SGEFA failed, returning INFO = ', info
end if
do i = 1, n
do j = 1, n
a(i,j) = real ( mult ) / real ( i + j - 1 )
end do
end do
r2(1) = 1.0E+00
r2(2:n) = 0.0E+00
job = 0
call sqrdc ( a, lda, n, n, qraux, ipivot, work, job )
job = 110
call sqrsl ( a, lda, n, n, qraux, r2, qy, qty, r2, rsd, ab, job, info )
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' First solution component only:'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' I, R1(I), R2(I)'
write ( *, '(a)' ) ' '
write ( *, '(i6,2g14.6)' ) i, r1(1), r2(1)
return
end
subroutine test13
!
!*******************************************************************************
!
!! TEST13
!
implicit none
!
integer, parameter :: n = 21
integer, parameter :: lda = n
!
real a(lda,n)
real ab(n)
integer i
integer info
integer ipivot(n)
integer j
integer job
integer lcm_12n
integer mult
real qraux(n)
real qty(n)
real qy(n)
real r1(n)
real r2(n)
real rsd(n)
real work(n)
!
write ( *, '(a)' ) ' '
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Exercise 13 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Solve a linear system A * x = b |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| A is the Hilbert matrix of order 21 |'
write ( *, '(a)' ) '| multiplied by the least common multiple of |'
write ( *, '(a)' ) '| 1 through 25 so all entries are integral. |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| B is (1,0,0,...,0) |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| We are interested in the first component |'
write ( *, '(a)' ) '| X(1) of the solution vector. |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Correct X(1): |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| 2.013145339298E-15 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' R1: Gauss elimination using SGEFA and SGESL'
write ( *, '(a)' ) ' R2: QR factorization using SQRDC and SQRSL.'
write ( *, '(a)' ) ' '
mult = lcm_12n ( n )
do i = 1, n
do j = 1, n
a(i,j) = real ( mult ) / real ( i + j - 1 )
end do
end do
r1(1) = 1.0E+00
r1(2:n) = 0.0E+00
call sgefa ( a, lda, n, ipivot, info )
if ( info == 0 )then
job = 0
call sgesl ( a, lda, n, ipivot, r1, job )
else
write ( *, '(a,i4)' ) ' SGEFA failed, returning INFO = ', info
end if
do i = 1, n
do j = 1, n
a(i,j) = real ( mult ) / real ( i + j - 1 )
end do
end do
r2(1) = 1.0E+00
r2(2:n) = 0.0E+00
job = 0
call sqrdc ( a, lda, n, n, qraux, ipivot, work, job )
job = 110
call sqrsl ( a, lda, n, n, qraux, r2, qy, qty, r2, rsd, ab, job, info )
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' First solution component only:'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' I, R1(I), R2(I)'
write ( *, '(a)' ) ' '
write ( *, '(i6,2g14.6)' ) i, r1(1), r2(1)
return
end
subroutine test14
!
!*******************************************************************************
!
!! TEST14
!
implicit none
!
integer, parameter :: n = 2
integer, parameter :: lda = n
!
real a(lda,n)
real ab(n)
integer info
integer ipivot(n)
integer job
real qraux(n)
real qty(n)
real qy(n)
real r1(n)
real r2(n)
real rsd(n)
real work(n)
!
write ( *, '(a)' ) ' '
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Exercise 14 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| A = [ 64079 57314 ] |'
write ( *, '(a)' ) '| [ 51860 46385 ] |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| B = [ 2 ] |'
write ( *, '(a)' ) '| [ 305 ] |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Solve: |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| A * X = B |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Correct X: |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| - 46368.0 |'
write ( *, '(a)' ) '| 51841.0 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' X(1) X(2)'
write ( *, '(a)' ) ' '
a(1,1) = 64079.0E+00
a(1,2) = 57314.0E+00
a(2,1) = 51860.0E+00
a(2,2) = 46385.0E+00
r1(1) = 2.0E+00
r1(2) = 305.0E+00
call sgefa ( a, lda, n, ipivot, info )
if ( info == 0 ) then
job = 0
call sgesl ( a, lda, n, ipivot, r1, job )
write ( *, '(a,2g14.6)' ) ' SGEFA/SGESL ', r1(1), r1(2)
else
write ( *, '(a)' ) ' SGEFA failed.'
end if
a(1,1) = 64079.0E+00
a(1,2) = 57314.0E+00
a(2,1) = 51860.0E+00
a(2,2) = 46385.0E+00
r2(1) = 2.0E+00
r2(2) = 305.0E+00
job = 0
call sqrdc ( a, lda, n, n, qraux, ipivot, work, job )
job = 110
call sqrsl ( a, lda, n, n, qraux, r2, qy, qty, r2, rsd, ab, job, info )
write ( *, '(a,2g14.6)' ) ' SQRDC/SQRSL ', r2(1), r2(2)
return
end
subroutine test15
!
!*******************************************************************************
!
!! TEST15
!
implicit none
!
real fx15
real h
integer i
real r
real x
!
write ( *, '(a)' ) ' '
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Exercise 15 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| F(X) = ( 4970 * X - 4923 ) |'
write ( *, '(a)' ) '| -------------------------------- |'
write ( *, '(a)' ) '| ( 4970 * X**2 - 9799 * X + 4830 ) |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Approximate F"(X) at X = 1 by: |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Del2(X)(F,H) = |'
write ( *, '(a)' ) '| ( F(X-H) - 2*F(X) + F(X+H) ) / H**2 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Correct values: |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| F"(1.0) = 94.0 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '| Del2(1.0)(F,1.0E-4) = 70.78819 |'
write ( *, '(a)' ) '| Del2(1.0)(F,1.0E-5) = 93.76790 |'
write ( *, '(a)' ) '| Del2(1.0)(F,1.0E-8) = 94.0 |'
write ( *, '(a)' ) '| |'
write ( *, '(a)' ) '+=============================================+'
write ( *, '(a)' ) ' '
write ( *, '(a)' ) ' H, Del2(X,H)'
x = 1.0E+00
do i = 1, 3
if ( i == 1 ) then
h = 1.0E-04
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -