Implicit none
include 'link_fnl_static.h'
parameter mxparam=50
!nr - число точек на координатной оси
!nt - число точек на временной оси
real*8 param(mxparam),y(n),yprime(n),t,tend,phi,
& tfinish,ht,tol,yy(n,nt+2),a(1,1),u,htrial,eps
integer i,ido,l,m,j,nstep,nfcn,nje
external fcn,fcnj
open(1,file='out_ur.dat')
open(2,file='out_ut.dat')
open(3,file='param.dat')
open(4,file='error.dat')
param=0.0
param(4)=500000.0 !макс число шагов
param(10)=1.0 !вычисляем абс ошибку
param(12)=2.0 !используем метод Гира дифференцирования назад
param(13)=2.0 !метод хорд с якобианом разделённых разностей
param(19)=0.0 !явная система,матрица А не сипользуется
tol=1.0e-7 !допуск ошибки
rl=2.0d0 !левая граница по радиусу
rr=10.0d0 !правая граница по радиусу
hr=(rr-rl)/(n-1) !шаг по координате
t=0.0d0 !начальный момент времени
ro(1)=rl;y(1)=phi(ro(1))
yy(1,1)=ro(1)
write(*,*)ro(1)
do i=2,n
ro(i)=ro(i-1)+hr !задание основной коорд. сетки
y(i)=phi(ro(i)) !и начальных значений y(i)
write(*,*)ro(i)
yy(i,1)=ro(i) !столбец с координатами точек сетки
end do
do i=1,n
yy(i,2)=y(i) !столбец начальных значений
end do
tfinish=10.0d0 !конечный момент времени
ht=tfinish/nt !шаг по времени
ido=1.0 !метка,характериз. стадию вычислений
write(2,88)t,y
do i=1,nt !решение системы из nr дифф. уравнений
tend=t+ht !в момент времени tend
call divpag(ido,n,fcn,fcnj,a,t,tend,tol,param,y)
if(ido==2) then
do l=1,n
yy(l,i+2)=y(l)
end do
write(2,88)t,y !вывод зависимости U(t)в разных точках сетки
else
write(1,*)'ido = ',ido
end if
!вывод погрешности в узлах в разные моменты времени
write(4,*)
do m=1,n
write(4,*) dabs(u(ro(m),t)-y(m))
end do
end do
do i=1,n
if(dabs(y(i)-u(ro(i),t)).gt.eps) then
eps=dabs(y(i)-u(ro(i),t))
end if
end do
do j=1,n !вывод зависимости U(r)в разные мом. времени
write(1,88)(yy(j,i),i=2,nt+2)
end do
write(1,88) t,eps
do i=1,n
write(1,88)ro(i),u(ro(i),t),y(i)
end do
write(1,88)
!вывод параметров для сравнения эффективности программ
nstep=param(34);nfcn=param(35)
nje=param(36);htrial=param(31)
! write(3,*)"nstep = ",nstep
! write(3,*)"nfcn = ",nfcn
! write(3,*)"nje = ",nje
! write(3,*)"htrial = ",htrial
write(3,*)htrial,nstep,nfcn,nje
ido=3.0
88 format(1x,23(e11.4,1x))
end program task1
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine fcn(nr,t,y,yprime)
use datamod
real*8 y(nr),yprime(nr),k,q,f,onu,tnu,t
! kapa=0.0d0 !1 u=1
kapa=1.0d0 !3 u=r*e^(-t)
yprime(1)=((rl+0.5d0*hr)*k(rl+0.5d0*hr,t)/hr*(y(2)-
& y(1))+rl*onu(t)-0.5d0*hr*rl*q(rl,t)*y(1)+0.5d0*hr*rl*f(rl,t))/
& (0.5d0*hr*rl)
do i=2,nr-1
yprime(i)=((ro(i)+0.5d0*hr)*k(ro(i)+0.5d0*hr,t)/hr*(y(i+1)-y(i))-
& (ro(i)-0.5d0*hr)*k(ro(i)-0.5d0*hr,t)/hr*(y(i)-y(i-1))-
& hr*ro(i)*q(ro(i),t)*y(i)+hr*ro(i)*f(ro(i),t))/
& (hr*ro(i))
end do
yprime(nr)=(-rr*(kapa*y(nr)-tnu(t))-(rr-0.5d0*hr)*k(rr-0.5d0*hr,t)
&*(y(nr)-y(nr-1))/hr-0.5d0*hr*rr*q(rr,t)*y(nr)+0.5d0*hr*rr*f(rr,t))
& /(0.5d0*hr*rr)
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine fcnj(nr,t,y,dypdy)
use datamod
integer nr
real*8 t,y(nr),dypdy(nr,nr)
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function k(r,t)
real*8 r,t
! k=1.0d0 !1
k=r**2.0d0
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function q(r,t)
implicit real*8 (a-h,k,o-z)
! q=0.0d0 !1
q=r*dexp(0.01d0*t)
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function f(r,t)
real*8 r,t
! f=0.0d0 !1
f=-3.01d0*r*dexp(-0.01d0*t)+r**2
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function onu(t) !ню один
real*8 t
! onu=0.0d0 !1
onu=-4.0d0*dexp(-0.01d0*t)
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function tnu(t) !ню два
real*8 t
! tnu=0.0d0 !1
tnu=110.0d0*dexp(-0.01d0*t)
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function phi(r) !начальное условие
real*8 r
! phi=1.0d0 !1
phi=r
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
double precision function U(r,t) !точное решение
real*8 r,t
! u=1.0d0
u=r*dexp(-0.01d0*t)
end
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3)Программа, использующая подпрограмму IVPAG с аналитическим вычислением матрицы Якоби
module datamod
parameter n=320,nt=20
real*8 ro(n),hr,kapa,rl,rr
end module datamod
program task1
use datamod