整理FORTRAN课程设计zwd.docx
- 文档编号:7486181
- 上传时间:2023-01-24
- 格式:DOCX
- 页数:24
- 大小:180.58KB
整理FORTRAN课程设计zwd.docx
《整理FORTRAN课程设计zwd.docx》由会员分享,可在线阅读,更多相关《整理FORTRAN课程设计zwd.docx(24页珍藏版)》请在冰豆网上搜索。
整理FORTRAN课程设计zwd
一、求一元方程的根
1、采用函数子程序定义一元方程;
2、程序选择以下三种方法求该方程的根;
METHOD=1牛顿迭代法
METHOD=2二分法
METHOD=3弦截法
3、对于不同的近似算法分别编写子程序,精度要求10-6。
一.用二分法、弦解法和牛顿迭代法求x2-6x-7=0的根。
1、二分法的基本思路:
(1)现任取两个值x1和x2,使得f(x1)*f(x2)<0,也就是f(x1)和f(x2)必须异号。
这才能保证在[x1,x2]区间有解,即存在一个x使得f(x)=0。
(2)令x=(x1+x2)/2,如果f(x)=0,就找到了这个解,计算完成。
由于f(x)是一个实型数据,所以在判断f(x)是否等于0时,是通过判断|f(x)|是否小于一个很小的数ε,如果是就认为f(x)=0。
(3)若f(x)不等于0,判断如果f(x1)和f(x)异号,就说明解在[x1,x]区间,就以x1,x为新的取值重复步骤
(2),这时用x代替否则x2,否则反之,直到找到满足条件的解为止。
程序编写如下:
realx1,x2,x
realbisect,func
do
print*,"输入x1,x2的值"
read*,x1,x2
if(func(x1)*func(x2)<0.0)exit
print*,"不正确的输入"
enddo
x=bisect(x1,x2)
print10,"x=",x
10format(a,f15.7)
end
realfunctionbisect(x1,x2)
realx1,x2,x,f1,f2,fx
x=(x1+x2)/2.0
fx=func(x)
dowhile(abs(fx)>1e-6)
f1=func(x1)
if(f1*fx<0)then
x2=x
else
x1=x
endif
x=(x1+x2)/2.0
fx=func(x)
enddo
bisect=x
end
functionfunc(x)
realx
func=x**2-6*x-7
end
二分法运行结果
2、弦解法的基本思路:
(1)现任取两个值x1和x2,使得f(x1)*f(x2)<0。
(2)做一条通过(x1,f(x1))和(x2,f(x2))两点的直线,这条直线与x轴的交点为x。
可用以下公式求出
X=x2-(x2-x1)*f(x2)/(f(x1)-f(x2)),
代入函数求得f(x),判断|f(x)|是否小于一个很小的数ε,如果是就认为f(x)=0。
(3)否则,判断如果f(x1)和f(x)异号,就说明解在[x1,x]区间,就以x1,x为新的取值重复步骤
(2),否则反之,然后以同样的办法再进一步缩小范围,直到|f(x)|<ε。
程序编写如下:
realx1,x2,x
realsecant,func
do
print*,'输入x1,x2的值'
read*,x1,x2
if(func(x1)*func(x2)<0)exit
print*,'不正确的取值'
enddo
x=secant(x1,x2)
print10,'x=',x
10format(a,f15.7)
end
realfunctionsecant(x1,x2)
implicitnone
realx1,x2,x,f1,f2,fx
realfunc
x=x2-(x2-x1)/(func(x2)-func(x1))*func(x2)
fx=func(x)
dowhile(abs(fx)>1e-6)
f1=func(x1)
if(f1*fx<0)then
x2=x
else
x1=x
endif
x=x2-(x2-x1)/(func(x2)-func(x1))*func(x2)
fx=func(x)
enddo
secant=x
end
realfunctionfunc(x)
realx
func=x**2-6*x-7
end
弦解法运行结果
3、牛顿迭代法基本思路:
(1)现任取一个值x1
(2)做一条通过(x1,f(x1))的切线,即以f'(x1)为斜率作直线,直线与x轴的交点为x2,
因为f'(x1)=f(x1)/(x1-x2)
x2=x1-f(x1)/f'(x1)
判断|f(x2)|<ε是否成立,如
果是就找到了这个解,计算完成。
(3)否则,重复步骤
(2),以f'(x1)为斜率做一条通过(x2,f(x2))的切线,直线与x轴的交点为x3,······,直到|f(xn)|<ε,即xn为所得解。
程序编写如下:
realx
integerm
print*,'输入初值'
read*,x
callnewton(x)
end
subroutinenewton(x)
implicitnone
realx,x1
realfunc,dfunc
integeri,m
i=1
x1=x-func(x)/dfunc(x)
dowhile(abs(x-x1)>1e-6)
print10,i,x1
x=x1
i=i+1
x1=x-func(x)/dfunc(x)
enddo
print20,'x=',x1
10format('i=',i4,6x,'x=',f15.7)
20format(a,f15.7)
end
realfunctionfunc(x)
realx
func=x**2-6*x-7
end
realfunctiondfunc(x)
realx
dfunc=2*x-6
end
牛顿迭代法运行结果
二、求定积分
1、采用函数子程序定义函数f(X);
2、程序选择以下三种方法求定积分:
矩形法、梯形法、辛普生法
3、对于不同的算法分别编写子程序,选择调用,比较不同方法求解的精度。
(一)用矩形法、梯形法和辛普生法分别求∫01(1+sinx)dx区间数为n=10,100,1000,5000时的值。
1、矩形法基本思路:
用小矩形面积代替小曲边梯形,矩形面积的求解公式为底×高。
将[a,b]区间分为n个区间,令h=(b-a)/n。
第1个矩形面积:
底=h,高=f(a),也可以用f(a+h)为高,S1=h·f(a)
第i个矩形面积:
底=h,高=f(a+(i-1)·h),也可以用f(a+i·h)为高,Si=h·f(a+(i-1)·h)
程序编写如下:
reala,b,s
integern
realyrectangle
print*,'输入a,b和n的值'
read*,a,b,n
s=rectangle(a,b,n)
print10,a,b,n
print20,s
10format('a=',f5.2,3x,'b=',f5.2,3x,'n=',i4)
20format('s=',f15.8)
end
realfunctionrectangle(a,b,n)
implicitnone
realx,a,b,h,s
integeri,n
realfunc
x=a
h=(b-a)/n
s=0
doi=1,n
s=s+func(x)*h
x=x+h
enddo
rectangle=s
end
realfunctionfunc(x)
realx
func=1+sin(x)
end
n=10时矩形法运行结果
n=100时矩形法运行结果
n=1000时矩形法运行结果
n=5000时矩形法运行结果
2、梯形法基本思路同上
reala,b,s
integern
realtrapezia
print*,'输入a,b和n的值'
read*,a,b,n
s=trapezia(a,b,n)
print10,a,b,n
print20,s
10format('a=',f5.2,3x,'b=',f5.2,3x,'n=',i4)
20format('s=',f15.8)
end
realfunctiontrapezia(a,b,n)
implicitnone
realx,a,b,h,s
integeri,n
realfunc
x=a
h=(b-a)/n
s=0
doi=1,n
s=s+(func(x+(i-1)*h)+func(x+i*h))*h/2.0
enddo
trapezia=s
end
realfunctionfunc(x)
realx
func=1+sin(x)
end
n=10时梯形法运行结果
n=100时梯形法运行结果
n=1000时梯形法运行结果
n=5000时梯形法运行结果
2、辛普生法:
程序编写如下:
reala,b,s
integern
realsinpson
print*,'输入a,b和n的值'
read*,a,b,n
s=sinpson(a,b,n)
print10,a,b,n
print20,s
10format('a=',f5.2,3x,'b=',f5.2,3x,'n=',i4)
20format('s=',f15.8)
end
realfunctionsinpson(a,b,n)
implicitnone
reala,b,h,f2,f4,x
integeri,n
realfunc
h=(b-a)/(2.0*n)
x=a+h
f2=0
f4=func(x)
doi=1,n-1
x=x+h
f2=f2+func(x)
x=x+h
f4=f4+func(x)
enddo
sinpson=(func(a)+func(b)+4.0*f4+2.0*f2)*h/3.0
end
realfunctionfunc(x)
realx
func=1+sin(x)
end
n=10时辛普生法运行结果
n=100时辛普生法运行结果
n=1000时辛普生法运行结果
n=5000时辛普生法运行结果
一、
{
利用Gauss-Jordan法求联立方程组:
x+4y+7z=12
2x+5y+8z=15
3x+6y+8z=17
程序编写如下:
real,allocatable:
:
a(:
:
),b(:
),c(:
)
print*,'输入未知数个数n'
read*,n
allocate(a(n,n))
allocate(b(n))
allocate(c(n))
print*,'输入系数矩阵a'
callinput(a,n)
print*,'输入等值矩阵b'
read*,b
print*,'联立方程组'
calloutput(a,b,n)
callGauss_jordan(a,b,c,n)
print*,"求解"
doi=1,n
print10,i,c(i)
enddo
10format('x',i1,'=',f8.4)
deallocate(a)
deallocate(b)
deallocate(c)
end
subroutineinput(a,n)
reala(n,n)
doi=1,n
read*,(a(i,j),j=1,n)
enddo
end
subroutineGauss_jordan(a,b,c,n)
dimensiona(n,n),b(n),c(n)
callup(a,b,n)
calllow(a,b,n)
forall(i=1:
n)
c(i)=b(i)/a(i,i)
endforall
end
subroutineoutput(a,b,n)
reala(n,n),b(n)
doi=1,n
print10,a(1,1),i
doj=2,n
if(a(i,j)>0)then
print20,a(i,j),j
else
print30,abs(a(i,j)),j
endif
enddo
print40,b(i)
enddo
10format(f5.2,'x',i1\)
20format('+',f5.2,'x',i1\)
30format('-',f5.2,'x',i1\)
40format('=',f8.4)
end
subroutineup(a,b,n)
reala(n,n),b(n)
doi=1,n-1
doj=i+1,n
p=a(j,i)/a(i,i)
a(j,i:
n)=a(j,i:
n)-a(i,i:
n)*p
b(j)=b(j)-b(i)*p
enddo
enddo
end
subroutinelow(a,b,n)
reala(n,n),b(n)
doi=n,2,-1
doj=i-1,1,-1
p=a(j,i)/a(i,i)
a(j,1:
i)=a(j,1:
i)-a(i,1:
i)*p
b(j)=b(j)-b(i)*p
enddo
enddo
end
方程组运行结果
三、编写程序完成链表的建立、插入、查找和删除等操作。
用链表完成学生情况的管理,已知学生信息包括姓名、学号和一门课成绩。
建立包括n个学生节点的链表(n由键盘输入),完成按学号的排序、插入、查找和删除等操作。
操作由菜单选择。
modulelink
typenode
integernum
character(10)name
realscore
type(node),pointer:
:
next
endtype
contains
subroutinecreat(head,n)
type(node),pointer:
:
head,p1,p2,p
integer:
:
i,num
nullify(head)
print*,'请输入学生基本数据:
'
doi=1,n
allocate(p1)
print10,"输入第",i,"个学生的数据:
"
print20,"学号:
"
read*,p1%num
print20,"姓名:
"
read*,p1%name
print20,"成绩:
"
read*,p1%score
nullify(p1%next)
if(i==1)then
head=>p1
elseif(p1%num
p1%next=>head
head=>p1
else
p2=>head
dowhile(p1%num>p2%num.and.associated(p2))
p=>p2
p2=>p2%next
enddo
if(associated(p2))then
p1%next=>p%next
p%next=>p1
else
p%next=>p1
endif
endif
enddo
10format(a,i3,2x,a)
20format(a,/)
endsubroutinecreat
subroutineoutput(head,n)
type(node),pointer:
:
head,p
integer:
:
i
p=>head
print30,"序号","学号","姓名","成绩"
doi=1,n
print40,i,p%num,p%name,p%score
p=>p%next
enddo
30format(a4,2x,a4,2x,a8,2x,a6)
40format(i3,3x,i4,2x,a8,2x,f4.1)
endsubroutineoutput
subroutineinsert(head,n)
type(node),pointer:
:
head,p,p0,p1
print*,'请输入插入学生的基本数据:
'
allocate(p0)
print20,"姓名:
"
read*,p0%name
print20,"学号"
read*,p0%num
print20,"成绩:
"
read*,p0%score
if(.not.associated(head))then
head=>p0
elseif(p0%num
p0%next=>head
head=>p0
else
p1=>head
dowhile(associated(p1).and.p1%num p=>p1 p1=>p1%next enddo if(associated(p1))then p0%next=>p%next p%next=>p0 else p%next=>p0 endif endif n=n+1 20format(a,/) endsubroutineinsert subroutinedel(head,n) type(node),pointer: : head,p,p0 print*,'请输入要删除学生的学号: ' read*,num if(.not.associated(head))then print*,'无学生数据,删除失败.' else p0=>head dowhile(associated(p0).and.p0%num/=num) p=>p0 p0=>p0%next enddo if(associated(p0))then if(associated(p0,head))then head=>p0%next deallocate(p0) else p%next=>P0%next deallocate(p0) endif print*,'删除: ',num,'的数据。 ' n=n-1 else print*,'查无此人,删除失败。 ' endif endif endsubroutinedel subroutineindexl(head) type(node),pointer: : head,p,p1 integernum print*,'请输入待查学生的学号' read*,num p=>head dowhile(associated(p)) if(p%num==num)then exit else p=>p%next endif enddo if(.not.associated(p))then print*,'查无此人! ' else print30,"序号","学号","姓名","成绩" print40,i,p%num,p%name,p%score endif 30format(a4,2x,a4,2x,a8,2x,a6) 40format(i3,3x,i4,2x,a8,2x,f4.1) endsubroutineindexl endmodulelink programexam10 uselink type(node),pointer: : head,p integern,num,key do print* print*,"选择菜单" print*,"_____________________________________________" print* print*,"1-输入学生数据","2-输出学生数据" print*,"3-添加学生数据","4-删除学生数据" print*,"5-查询学生数据","6-退出" print*,"____________________________________________" print* print'(a,\)',"请输入选择操作的序号: " read*,key if(key==1)then print*,"请输入学生人数" read*,n callcreat(head,n) 以森林为例,木材、药品、休闲娱乐、植物基因、教育、人类住区等都是森林的直接使用价值。 calloutput(head,n) 在可行性研究时应进行安全预评价的建设项目有: elseif(key==2)then calloutput(head,n) elseif(key==3)then (4)根据评价的目的、要求和评价对象的特点、工艺、功能或活动分布,选择科学、合理、适用的定性、定量评价方法对危险、有害因素导致事故发生的可能性及其严重程度进行评价。 callinsert(head,n) 2.早期介入原则;elseif(key==4)then (三)环境标准和环境影响评价技术导则calldel(head,n) 为了有别于传统的忽视环境价值的理论和方法,环境经济学家把环境的价值称为总经济价值(TEV),包括环境的使用价值和非使用价值两个部分。 elseif(key==5)then callindexl(head) 1)地方环境标准是对国家环境标准的补充和完善。 在执行上,地方环境标准优先于国家环境标准。 else exit endif enddo 大纲要求end 程序调试结果 2)间接使用价值。 间接使用价值(IUV)包括从环境所提供的用来支持目前的生产和消费活动的各种功能中间接获得的效益。 (二)环境保护法律法规体系
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 整理 FORTRAN 课程设计 zwd