兰州交通大学fortran课程设计

目录

1求一元方程的根和求定积分 (1)

1.1 求一元方程的根 (1)

二分法 (1)

1.1.1 弦截法 (3)

1.1.2 牛顿迭代法 (5)

1.2 求定积分 (7)

1.2.1矩形法 (7)

1.2.2 梯形法 (9)

1.2.3 辛普生法： (11)

2求解线性方程组 (13)

3 编写程序完成链表的建立、插入、查找和删除等操作 (17)

1求一元方程的根和求定积分

1.1 求一元方程的根

作业要求

1、采用函数子程序定义一元方程；

2、程序选择以下三种方法求该方程的根；

METHOD = 1 牛顿迭代法

METHOD = 2 二分法

1METHOD = 3 弦截法

3、对于不同的近似算法分别编写子程序，精度要求10-6。

本题用二分法、弦解法和牛顿迭代法求x3-2x2+7x+4=0的根来编写程序求解。二分法

二分法基本思路：

现任取两个值x

1和x

2

，使得f（x

1

）* f（x

2

）<0，也就是f（x

1

）和f（x

2

）必须

异号。这才能保证在［x

1，x

2

］区间有解，即存在一个x使得f（x）=0。

令x=（x

1+x

2

）/2，如果f（x）=0，就找到了这个解，计算完成。由于f（x）是

一个实型数据，所以在判断f（x）是否等于0时，是通过判断｜f（x）｜是否小于一个很小的数ε，如果是就认为f（x）=0。

若f（x）不等于0，判断如果f（x

1）和f（x）异号，就说明解在［x

1，

x］区间，

就以x

1，x为新的取值重复步骤（2），这时用x代替否则x

2，

否则反之，直到找

到满足条件的解为止。

程序编写如下：

program lt12_1

real x1 ,x2,x

real bisect,func !对要调用的子程序作说明

do !输入x1和x2直到f(x1)和f(x2)异号为止print*,'输入x1，x2的值:'

read*,x1,x2

if(func(x1)*func(x2)<0.0) exit

print*,'不正确的输入！'

end do

x=bisect(x1,x2) !调用二分法求解函数print 10, 'x=',x !输出计算结果

10 format(a,f15.7)

end

real function bisect(x1,x2) !二分法求解函数real x1,x2,x,f1,f2,fx

x=(x1+x2)/2.0

fx=func(x)

do while(abs(fx)>1e-6)

f1=func(x1)

if(f1*fx<0) then

x2=x

else

x1=x

end if

x=(x1+x2)/2.0

fx=func(x)

end do

bisect=x

end

function func(x) !需要求解的函数

real x

func=x**3-2*x**2+7*x+4

end

运行结果：

1.1.1弦截法

弦截法的基本思路：

现任取两个值x

1和x

2

，使得f（x

1

）* f（x

2

）<0。

（1）做一条通过（x

1，f（x

1

））和（x

2

，f（x

2

））两点的直线，这条直线与x轴

的交点为x。可用以下公式求出

X=x

2-（x

2

- x

1

）* f（x

2

）/（f（x

1

）- f（x

2

）），

（2）代入函数求得f（x），判断｜f（x）｜是否小于一个很小的数ε，如果是就认为f（x）=0。

（3）否则，判断如果f（x

1）和f（x）异号，就说明解在［x

1，

x］区间，就以

x

1，

x为新的取值重复步骤（2），否则反之，然后以同样的办法再进一步缩小范围，直到｜f（x）｜<ε。

程序编写如下：

real x1,x2,x

real secant,func !对要调用的子程序作说明

do !输入x1和x2直到f(x1)和f(x2)异号为止print*,'输入x1,x2的值'

read*,x1,x2

if(func(x1)*func(x2)<0)exit

print*,'不正确的取值'

enddo

x=secant(x1,x2) !调用弦截法求解函数

print 10,'x=',x !输出计算结果

10 format(a,f15.7)

End

real function secant(x1,x2) !弦截法求解函数implicit none

real x1,x2,x,f1,f2,fx

real func

x=x2-(x2-x1)/(func(x2)-func(x1))*func(x2)

fx=func(x)

do while(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

real function func(x) !需要求解的函数

real x

func= x**3-2*x**2+7*x+4

end

运行结果：

1.1.2牛顿迭代法

牛顿迭代法基本思路 （1）现任取一个值x 1

（2）做一条通过（x 1，f （x 1））的切线，即以f ＇（x 1）为斜率作直线，直线与x

轴的交点为x 2，

因为f ＇（x 1）= f （x 1）/(x 1- x 2） x 2=x 1- f （x 1）/ f ＇（x 1） 判断｜f （x 2）｜<ε是否成立，如

果是就找到了这个解，计算完成。

（3）否则，重复步骤（2），以f ＇（x 1）为斜率做一条通过（x 2，f （x 2））的切线，

直线与x 轴的交点为x 3，······，直到｜f （x n ）｜<ε，即x n 为所得解。 程序编写如下： real x integer m print*,'输入初值' read*,x

call newton(x) !调用牛顿迭代法求解函数 end

subroutine newton(x) ! 牛顿迭代法求解函数 implicit none real x,x1

real func,dfunc !对要调用的子程序作说明

integer i,m

i=1

x1=x-func(x)/dfunc(x)

do while(abs(x-x1)>1e-6)

print 10,i,x1

x=x1

i=i+1

x1=x-func(x)/dfunc(x)

enddo

print 20,'x=',x1 !输出计算结果10 format('i=',i4,6x,'x=',f15.7)

20 format(a,f15.7)

End

real function func(x) !迭代函数

real x

func= x**3-2*x**2+7*x+4

end

real function dfunc(x)

real x

dfunc=3*x**2-4*x+7

end

运行结果：

1.2 求定积分

作业要求：

1、采用函数子程序定义函数f （X ）；

2、程序选择以下三种方法求定积分： 矩形法、梯形法、辛普生法

3、对于不同的算法分别编写子程序，选择调用，比较不同方法求解的精度。 本题我们用?+1

0)sin 1(dx x 来讨论矩形法、梯形法、辛普生法求定积分的方法。

1.2.1 矩形法

矩形法基本思路：

用小矩形面积代替小曲边梯形，矩形面积的 求解公式为底×高。将［a ，b ］区间分为n 个区间，令h=（b-a ）/n 。

第1个矩形面积：底=h ，高= f （a ），也可以用f （a+h ）为高，S 1=h ·f （a ） 第i 个矩形面积：底=h ，高= f （a+（i-1）·h ），也可以用f （a+i ·h ）为高，S i =h ·f （a+（i-1）·h ） 程序编写如下： real a,b,s integer n real yrectangle

print*,'输入a,b 和n 的值' read*,a,b,n s=rectangle(a,b,n) print 10,a,b,n print 20,s

10 format('a=',f5.2,3x,'b=',f5.2,3x,'n=',i4) 20 format('s=',f15.8) End

real function rectangle(a,b,n)

implicit none

real x,a,b,h,s

integer i,n

real func

x=a

h=(b-a)/n

s=0

do i=1,n

s=s+func(x)*h

x=x+h

enddo

rectangle=s

end

real function func(x)

real x

func=1+sin(x)

end

运行结果：

n=10时的输出结果

n=100时的输出结果

n=1000时的输出结果

1.2.2梯形法

梯形法基本思路同上，用小梯形面积代替小曲边梯形

=h·f（a）第1个梯形面积：底=h，高= f（a），也可以用f（a+h）为高，S

1

第i个梯形面积：底=h，高= f（a+（i-1）·h），也可以用f（a+i·h）为高，=h·f（a+（i-1）·h）

S

i

程序设计如下

real a,b,s

integer n

real trapezia

print*,'输入a,b和n的值'

read*,a,b,n

s=trapezia(a,b,n)

print 10,a,b,n

print 20,s

10 format('a=',f5.2,3x,'b=',f5.2,3x,'n=',i4)

20 format('s=',f15.8)

end

real function trapezia(a,b,n)

implicit none

real x,a,b,h,s

integer i,n

real func

x=a

h=(b-a)/n

s=0

do i=1,n

s=s+(func(x+(i-1)*h)+func(x+i*h))*h/2.0 enddo

trapezia=s

end

real function func(x)

real x

func=1+sin(x)

end

运行结果：

n=10时的输出结果

n=100时的输出结果

n=1000时的输出结果1.2.3辛普生法：

程序编写如下：

real a,b,s

integer n

real sinpson

print*,'输入a,b和n的值'

read*,a,b,n

s=sinpson(a,b,n)

print 10,a,b,n

print 20,s

10 format('a=',f5.2,3x,'b=',f5.2,3x,'n=',i4)

20 format('s=',f15.8)

end

real function sinpson(a,b,n)

implicit none

real a,b,h,f2,f4,x

integer i,n

real func

h=(b-a)/(2.0*n)

x=a+h

f2=0

f4=func(x)

do i=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

real function func(x)

real x

func=1+sin(x)

end

n=10时的输出结果

n=100时的输出结果

n=1000时的输出结果

通过对数据分析我们可以发现，辛普生法最为准确，其次为梯形法，矩形法精度最差

2

求解线性方程组

作业要求

用高斯消元法求解线性方程组AX=B 的解

其中A 为n*n 系数矩阵，x 为解向量，B 为方程组右端维列向量。

要求程序能够求解任意多个未知数的方程组，并附算例及求解结果。

利用Gauss-Jordan 法求联立方程组：

有以下联立方程组：

??

?

??=-+=++=++1321014

3z y x z y x z y x 这组等式可以用矩阵方式表示

=a ?????1

321

11123-????? ??????????=z y x c ????

?

?????=11014b 他们的关系为b c a =?，c 为要求解的未知数。我们可以先用子程序将矩阵转化

为三角矩阵，然后再根据有关方法求出函数的解。 程序编写如下：

real,allocatable::a(:,:),b(:),c(:)

print*,'输入未知数个数n'

read*,n

allocate(a(n,n))

allocate(b(n))

allocate(c(n))

print*,'输入系数矩阵a'

call input(a,n)

print*,'输入等值矩阵b'

read*,b

print*,'联立方程组'

call output(a,b,n)

call Gauss_jordan(a,b,c,n)

print*,"求解"

do i=1,n

print 10,i,c(i)

enddo

10 format('x',i1,'=',f8.4)

deallocate(a)

deallocate(b)

deallocate(c)

end

subroutine input(a,n) !输入子程序real a(n,n)

do i=1,n

read*,(a(i,j),j=1,n)

enddo

end

subroutine Gauss_jordan(a,b,c,n) !高斯消元法的运算dimension a(n,n),b(n),c(n)

call up(a,b,n) !引用上三角矩阵子程序call low(a,b,n) !引用下三角矩阵子程序forall(i=1:n)

c(i)=b(i)/a(i,i)

endforall

end

subroutine output(a,b,n) !输出联立方程组

real a(n,n),b(n)

do i=1,n

print 10,a(1,1),i

do j=2,n

if(a(i,j)>0)then

print 20,a(i,j),j

else

print 30,abs(a(i,j)),j

endif

enddo

print 40,b(i)

enddo

10 format(f5.2,'x',i1\)

20 format('+',f5.2,'x',i1\)

30 format('-',f5.2,'x',i1\)

40 format('=',f8.4)

End

subroutine up(a,b,n) !上三角矩阵子程序

real a(n,n),b(n)

do i=1,n-1

do j=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

subroutine low(a,b,n) !下三角矩阵子程序real a(n,n),b(n)

do i=n,2,-1

do j=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

3编写程序完成链表的建立、插入、查找和删除等操作

作业要求

用链表完成学生情况的管理，已知学生信息包括姓名、学号和一门课成绩。建立包括n个学生节点的链表（n由键盘输入），完成按学号的排序、插入、查找和删除等操作。操作由菜单选择。

分析：

本题可以用指针来实现数据的传递，用子程序的有关内容完成按学号的排序、插入、查找和删除等操作，再用主程序将各个子程序结合在一起。实现学生情况管理链表的完成。

程序编写如下：

module link

type node

integer num

character(10) name

real score

type(node),pointer::next

end type

contains

subroutine creat(head,n)

type(node),pointer::head,p1,p2,p

integer::i,num

nullify(head)

print*,'请输入学生基本数据：'

do i=1,n

allocate(p1)

print 10,"输入第",i,"个学生的数据："

print 20,"学号："

read*,p1%num

print 20,"姓名："

read*,p1%name

print 20,"成绩："

read*,p1%score

nullify(p1%next)

if(i==1) then

head=>p1

else

p2=>head

do while(p1%num>p2%num.and.associated(p2)) p=>p2

p2=>p2%next

end do

if(associated(p2)) then

p1%next=>p%next

p%next=>p1

else

p%next=>p1

endif

endif

enddo

10 format(a,i3,2x,a)

20 format(a,\)

end subroutine creat

subroutine output(head,n)

type(node),pointer::head,p

integer::i

p=>head

print 30,"序号","学号","姓名","成绩"

do i=1,n

print 40,i,p%num,p%name,p%score

p=>p%next

enddo

30 format(a4,2x,a4,2x,a8,2x,a6)

40 format(i3,3x,i4,2x,a8,2x,f4.1)

end subroutine output

subroutine insert(head,n)

type(node),pointer::head,p,p0,p1

print*,'请输入插入学生的基本数据：' allocate(p0)

print 20,"姓名："

read*,p0%name

print 20,"学号："

read*,p0%num

print 20,"成绩："

read*,p0%score

if(.not.associated(head)) then

head=>p0

else if(p0%num

p0%next=>head

head=>p0

else