西安交通大学fortran习题.docx
《西安交通大学fortran习题.docx》由会员分享,可在线阅读,更多相关《西安交通大学fortran习题.docx(23页珍藏版)》请在冰豆网上搜索。
西安交通大学fortran习题
1二维数组的输入与输出
programmain
implicitnone
integeri,j
integerA(2,2)
!
若为
data((A(j,i),i=1,2),j=1,2)/1,2,3,4/
print*,A
end
!
结果为1324
实际为A(1,1)=1A(1,2)=2A(2,1)=3A(2,2)=4
!
若为
data((A(i,j),i=1,2),j=1,2)/1,2,3,4/
print*,A
end
!
结果为1234
实际为A(1,1)=1A(2,1)=2A(1,2)=3A(2,2)=4
programmain
implicitnone
integeri,j
integerA(2,2)
data((A(i,j),i=1,2),j=1,2)/1,2,3,4/
write(*,"(I3,I3)")A
end
!
结果为12
34
翻卡片
!
用数组编写下面的题目:
假定有一叠卡片,卡片号为1到52,并且所有卡片的正面朝上。
从卡片号2开始,把凡是偶数的卡片都翻
成正面朝下。
再从3号卡片开始,把凡是卡片号为3的倍数的卡片都翻一个面(即把正面朝上的翻成正面
朝下,正面朝下的翻成正面朝上)。
下一步从4号卡片开始,把凡是卡片号为4的倍数的卡片都翻一个面,
依次类推,直到从52号卡片开始,把凡是卡号为52的倍数的卡片翻一个面。
写出一个程序,来测定全过
程完成后,哪些卡片的面朝上,共有几张。
答案:
正面朝上的卡片是第1、4、9、16、25、36、49张,共7张。
programmain
implicitnone
integers(52)
integeri,j
s=0
doi=2,52
j=i
dowhile(j<=52)
s(j)=s(j)+1
j=j+i
enddo
enddo
doi=1,52
if(mod(s(i),2)==0)then
write(*,*)i
endif
enddo
endprogrammain
//用C语言写
#include
intmain()
{
ints[52];
inti,j;
for(i=0;i<52;i++)s[i]=0;
for(i=1;i<=51;i++)
{
for(j=i;j<=51;j+=i+1)//也可以写作j=j+i+1,不能写作j==j+i+1
{
s[j]=s[j]+1;
}
}
斐波拉契
!
使用递归时result()不能与函数名相同
PROGRAMMAIN
IMPLICITNONE
INTEGERn,i,sum
read*,n
if(n<0)THEN
PRINT*,"出错"
ENDIF
write(*,*)'f(n)=',f(n)
doi=1,n
sum=sum+f(n)
enddo
write(*,*)'sum=',sum
contains
recursivefunctionf(n)result(g)
integerg,n
if(n==0)then
g=0
elseif(n==1.or.n==2)then
g=1
else
g=f(n-1)+f(n-2)
endif
endfunction
Endprogram
分解质因数
!
分解质因数
programmain
implicitnone
integera,c,i,b
print*,"请输入一个大于二的整数"
read*,a
print*,'则它的所有质因子为'
dowhile(a/=1)
i=1
b=1
dowhile(b/=0)
i=i+1
b=mod(a,i)
c=i
enddo
a=a/c
print*,c
enddo
endprogram
哥德巴赫猜想
!
屏幕上不能显示500行,所以不能将结果完全显示,需要将结果输入文件
FUNCTIONf(i)
IMPLICITNONE
INTEGERi,f,h
f=0
if(i>1)then
doh=2,i-1
if(mod(i,h)==0)then
f=f+1
endif
enddo
endif
endfunction
programmain
implicitnone
integer(4)i,j,n,f
integers
don=4,600,2
s=0
j=0
doi=1,n/2-1
j=n-i
if(f(i)==0.and.f(j)==0)then
s=s+1
endif
enddo
if(s==0)then
print*,n,'不满足猜想'
else
print*,n,s
endif
enddo
endprogram
黄金值法解方程
!
将中值法中取中点的值改为取黄金点的值,理论上可以提高效率
modulegolden_section
implicitnone
reala,b,c
contains
subroutinesub1(a,b,c)
reala,b,c,yc
c=(a*0.618+b)/1.618
yc=f(c)
dowhile(abs(yc)>0.00001)
if(yc*f(a)<0)then
b=c
else
a=c
endif
c=(a*0.618+b)/1.618
yc=f(c)
enddo
endsubroutine
functionf(x)
realf,x
f=x*x-4.0*x+3
endfunction
endmodulegolden_section
programmain
usegolden_section
implicitnone
reale
print*,"请输入解的下界a"
read*,a
print*,"请输入解的上界b"
read*,b
e=f(a)*f(b)
!
用一个循环来判断输入值是否合适,或者就是解
if(f(a)==0)then
print*,a
elseif(f(b)==0)then
print*,b
else
dowhile(e>0)
print*,"f(a)=,f(a);f(b)=,f(b);请重新输入下界a"
read*,a
print*,"请重新输入解的下界b"
read*,b
enddo
callsub1(a,b,c)
endif
print*,c
end
回文输出
programmain
implicitnone
integeri,j
integera(5),b(5)
dataa/1,2,8,2,10/
datab/2,3,4,5,6/
doi=1,5
doj=1,5
b(j)=b(j)-1
if(b(j)<1)then
b(j)=b(j)+5
endif
enddo
print*,a(b(1:
5))!
实践证明这是正确的输出方法
enddo
end
!
forall语句中不能使用if语句,但可以用where语句,注意()中的内容变化
但本题从逻辑上就应该先做完forall,再做where,故不必嵌套
programmain
implicitnone
integeri,j
integera(6),b(6)
DATAa/1,4,9,16,25,36/
datab/2,3,4,5,6,7/
doi=1,6
forall(j=1:
6)
b(j)=b(j)-1
endforall
where(b==0)!
可以写为where(b(:
)==0)
b(:
)=b(:
)+6
endwhere
b=b+6
endwhere
print*,a(b(1:
6))!
实践证明这是正确的输出方法
enddo
回文数据若干相邻想和并比较大小
!
1.圆盘上有如图1
(1)所示的20个数。
请找出哪四个相邻的数之和为最大。
请指出他们的位置和数值。
如果是1
(2)图,又是哪四个相邻的数?
programmain
implicitnone
integera(20),b(23),c(20)
integeri,j,d,e
dataa/20,21,8,4,13,6,10,15,2,17,3,19,7,16,8,11,14,9,12,5/
datab/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,1,2,3/
doi=1,20
c(i)=a(b(i))+a(b(i+1))+a(b(i+2))+a(b(i+3))
enddo
e=1
doi=1,19
if(c
(1)d=c
(1)
c
(1)=c(i+1)
c(i+1)=d
e=i+1
endif
enddo
print*,c
(1)
write(*,*)(a(b(i)),i=e,e+3)
end
//用C语言写,注意C的数组从0开始计数,所有的i变量减一;嵌套数组仍然有效
#include
intmain()
{
inta[20]={20,21,8,4,13,6,10,15,2,17,3,19,7,16,8,11,14,9,12,5};
intb[23]={0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,0,1,2};
intc[20];
inti,j,d,e;
for(i=0;i<=18;i++)
{
c[i]=a[b[i]]+a[b[i+1]]+a[b[i+2]]+a[b[i+3]];
}
e=0;
for(i=0;i<=18;i++)
{if(c[0]{d=c[0];
c[0]=c[i+1];
c[i+1]=d;
e=i+1;
}
}
printf("和最大的是%d,这四个数是:
\n",c[0]);
for(i=e;i<=e+3;i++)
printf("%d,",a[b[i]]);
return0;
}
!
圆盘上有如图所示的K个数。
请找出哪l个相邻的数之和为最大。
请指出他们的位置和数值。
programmain
implicitnone
integeri,j,d,e
integerk,l
integer,allocatable:
:
a(:
),b(:
),c(:
)
print*,"请输入数据的总数"
read*,k
print*,"请输入求和的元素个数"
read*,l
allocate(a(k),b(k+l-1),c(k))
print*,"请依次输入数据"
doi=1,k
read*,a(i)
enddo
doi=1,k
b(i)=i
enddo
doi=k+1,k+l-1
b(i)=i-k
enddo
doi=1,k
doj=i,i+l-1
c(i)=c(i)+a(b(j))!
一维数组嵌套的功能可由二维数组代替
enddo
enddo
e=1
doi=1,k-1
if(c
(1)d=c
(1)
c
(1)=c(i+1)
c(i+1)=d
e=i+1
endif
enddo
print*,'和最大为',c
(1),'这些数为'
write(*,*)(a(b(i)),i=e,e+l-1)
end
计算六边形的面积
PROGRAMMAIN
IMPLICITNONE
REALAREA,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12
PRINT*,"请输入将六边形分割成三角形后各个三角形的边长"
PRINT*,"第一个三角形三边为"
READ*,L1,L2,L3
PRINT*,"第二个三角形三边为"
READ*,L4,L5,L6
PRINT*,"第三个三角形三边为"
READ*,L7,L8,L9
PRINT*,"第四个三角形三边为"
READ*,L10,L11,L12
AREA=F(L1,L2,L3)+F(L4,L5,L6)+F(L7,L8,L9)+F(L10,L11,L12)
write(*,*)AREA
CONTAINS
FUNCTIONF(A,B,C)
REALF,A,B,C,S
S=(A+B+C)/2
F=SQRT(S*(S-A)*(S-B)*(S-C))
ENDFUNCTION
END
计算最大公约数和最小公倍数
PROGRAMMAIN
!
计算两个数的最小公倍数与最大公约数
IMPLICITNONE
INTEGERX,Y,F,G
PRINT*,"请输入两个正整数"
READ*,X,Y
G=X*Y/F(X,Y)
write(*,*)"最大公因数为",F(X,Y)
write(*,*)"最小公倍数为",G
ENDPROGRAMMAIN
!
F
FUNCTIONF(X,Y)
IMPLICITNONE
INTEGERX,Y,Z,F
IF(XZ=Y
Y=X
X=Z
ENDIF
Z=X-Y
DOWHILE(Z/=Y)
IF(Z>Y)THEN
X=Z
ELSE
X=Y
Y=Z
ENDIF
Z=X-Y
ENDDO
F=Z
ENDFUNCTION
牛顿法解方程
!
牛顿法解方程,效率高,但是方程有多解时,解对初值很敏感;另外还要求函数处处可导
modulenewton
implicitnone
realx,y,k,v
contains
subroutinesub1(x)
realx,k,y
realdx
dx=0.00001
y=f(x)
k=(f(x)-f(x-dx))/dx
dowhile(abs(y)>0.00001)
x=x-y/k!
注意方程不要解错
y=f(x)
enddo
endsubroutine
functionf(x)
realf,x
f=x*x-4.0*x+3
endfunction
endmodulenewton
programmain
usenewton
implicitnone
print*,"请输入初值x:
"
read*,x
callsub1(x)
print*,x
endprogrammain
牛追人问题
!
用派生定义坐标,但没有定义向量运算符
本题可以不用派生,直接定义坐标变量,应该可以简化。
精度由v的增量,时间间隔t,判定相遇的临界距离三者决定
modulemodule1
implicitnone
typevector
realx
realy
endtype
!
下面的声明语句可以不要,但私下下认为不应省略
type(vector):
:
va,vc,ra,rc,dr!
模块中定义了type后,其他例程都不用再定义但要声明变量
realv,t
contains
functionnorm(r)
realnorm
type(vector):
:
r
norm=(r.x*r.x+r.y*r.y)**0.5
endfunction
subroutinesub1(v,ra)
type(vector):
:
va,vc,ra,rc,dr
realv,t
t=0.1
ra.x=10
ra.y=50
rc.x=0
rc.y=0
vc.x=5.0/(26**0.5)
vc.y=5.0/(26**0.5)*5
va.x=v*2.0/(5**0.5)
va.y=v*(-1.0)/(5**0.5)
dr.x=ra.x
dr.y=ra.y
dowhile(norm(dr)>1)
rc.x=rc.x+vc.x*t
rc.y=rc.y+vc.y*t
ra.x=ra.x+va.x*t
ra.y=ra.y+va.y*t
dr.x=ra.x-rc.x
dr.y=ra.y-rc.y
vc.x=5*dr.x/(norm(dr))
vc.y=5*dr.y/(norm(dr))
enddo
endsubroutinesub1
endmodule
programmain
usemodule1
implicitnone
v=0
print*,'小孩的速度应为'
ra.x=10
ra.y=50
dowhile(ra.x<60.0)
v=v+0.1
ra.x=10
ra.y=50
callsub1(v,ra)
write(*,*)v,ra.x
enddo
write(*,*)v
end
判断闰年
subroutinesub1(p)
implicitnone
integer,target:
:
p
integer,pointer:
:
a
integeri,j,s
if(mod(p,400)==0.or.mod(p,100)/=0.and.mod(p,4)==0)then!
事实证明这么写是正确的
a=>p
print*,a
endif
endsubroutine
programmain
implicitnone
integeri
integer,target:
:
p
dop=1900,2008
callsub1(p)
enddo
endprogrammai
最大公约数
!
辗转相除法
PROGRAMMAIN
IMPLICITNONE
INTEGERM,N
PRINT*,"请输入两个正整数"
read*,M,N
print*,'他们的最大公约数为'
print*,F(M,N)
contains
FUNCTIONF(M,N)
integerM,N,F,I,P
I=1
IF(MP=M
M=N
N=P
ENDIF
DOWHILE(I/=0)
I=MOD(M,N)
M=N
N=I
ENDDO
F=M
ENDFUNCTION
ENDPROGRAM
!
秦九韶算法
PROGRAMMAIN
IMPLICITNONE
INTEGERM,N
PRINT*,"请输入两个正整数"
read*,M,N
print*,'他们的最大公约数为'
print*,F(M,N)
contains
FUNCTIONF(M,N)
integerM,N,F,I,P
I=1
DOWHILE(I/=0)
IF(MP=M
M=N
N=P
ENDIF
I=M-N
梯形积分
moduleintegral
implicitnone
integern
reala,b
contains
functions(n,a,b)
integern
reala,b
integeri
reals,h
h=(b-a)/n
s=0
doi=1,n,1
s=s+(f(a+h*(i-1))+f(a+h*i))/2*h
enddo
endfunction
functionf(x)
realx,f
f=exp(x)
endfunction
endmoduleintegral
programmain
useintegral
implicitnone
write(*,*)"被积函数f=e^x,请输入积分下限a,与积分上限b:
"
read*,a,b
write(*,*)"请输入n,"
read*,n
print*,"积分结果为:
",s(n,a,b)
endprogrammain
用幂级数近似计算
PROGRAMMAIN
IMPLICITNONE
REAL(8)X,SIN,A
READ*,X
CALLISIN(X,SIN,A)
PRINT*,SIN
ENDPROGRAM
SUBROUTINEISIN(X,SIN,A)
IMPLICITNONE
REAL(8)SIN,X,A
INTEGERI
I=0
SIN=X!
明确累加从何开始
A=X
DOWHILE(ABS(A)>=0.0000006)
I=I+1
A=A*(-1)*X*X/(I*2+1)/(2*I)
SIN=SIN+A
ENDDO
ENDSUBROUTIN