西安交通大学fortran习题.docx
《西安交通大学fortran习题.docx》由会员分享，可在线阅读，更多相关《西安交通大学fortran习题.docx（18页珍藏版）》请在冰豆网上搜索。
西安交通大学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（2,2）=4
实际为A（1,1）=1A（1,2）=2A（2,1）=3
!
若为
data（（A（i,j）,i=1,2）,j=1,2）/1,2,3,4/
print*,A
end
!
结果为1234
A（2,2）=4
实际为A（1,1）=1A（2,1）=2A（1,2）=3programmain
implicitnone
integeri,j
integerA（2,2）data（（A（i,j）,i=1,2）,j=1,2）/1,2,3,4/write（*,"（l3,l3）"）A
end
!
结果为12
34
翻卡片
!
用数组编写下面的题目：
假定有一叠卡片，卡片号为1到52,并且所有卡片的正面朝上。
从卡片号2开始，把凡是偶数
的卡片都翻
成正面朝下。
再从3号卡片开始，把凡是卡片号为3的倍数的卡片都翻一个面（即把正面朝上
的翻成正面
朝下，正面朝下的翻成正面朝上）。
下一步从4号卡片开始，把凡是卡片号为4的倍数的卡片都翻一个面，
依次类推，直到从52号卡片开始，把凡是卡号为52的倍数的卡片翻一个面。
写出一个程序，
来测定全过
程完成后，哪些卡片的面朝上，共有几张。
答案：
正面朝上的卡片是第1、4、9、16、25、36、49张，共7张。
programmainimplicitnoneintegers（52）integeri,js=0doi=2,52j=i
dowhile（j<=52）s（j）=s（j）+1j=j+ienddo
enddo
doi=1,52
if（mod（s（i）,2）==0）thenwrite（*,*）iendifenddo
endprogrammain
II用C语言写
#includeintmain（）
{
ints[52];
inti,j;
for（i=0;i<52;i++）s[i]=0;
for（i=1;i<=51;i++）
也可以写作j=j+i+1,不能写作j==j+i+1
{
for（j=i;j<=51;j+=i+1）II{
s[j]=s[j]+1;
斐波拉契
!
使用递归时result（）不能与函数名相同
PROGRAMMAINIMPLICITNONEINTEGERn,i,sumread*,nif（n<0）THENPRINT*,"出错"
ENDIF
write（*,*）'f（n）=',f（n）doi=1,nsum=sum+f（n）enddowrite（*,*）'sum=',sumcontainsrecursivefunctionf（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+1endifenddoendif
endfunction
programmain
implicitnoneinteger（4）i,j,n,fintegers
don=4,600,2
s=0
j=0
doi=1,n/2-1
j=n_i
if（f（i）==O.and.f（j）==O）thens=s+1endif
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）b=c
else
a=c
endif
c=（a*0.618+b）/1.618yc=f（c）enddo
endsubroutine
functionf（x）
realf,xf=x*x-4.0*x+3endfunctionendmodulegolden_sectionprogrammainusegolden_sectionimplicitnonereale
print*,"请输入解的下界a"
read*,a
print*,"请输入解的上界b"
read*,be=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
enddocallsub1（a,b,c）endif
print*,cend
回文输出
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，故不必嵌套programmainimplicitnoneintegeri,jintegera（6）,b（6）
DATAa/1,4,9,16,25,36/datab/2,3,4,5,6,7/doi=1,6forall（j=1:
6）b（j）=b（j）-1endforall
where（b==0）
b=b+6endwhere
!
可以写为where（b（:
）==0）b（:
）=b（:
）+6endwhere
print*,a（b（1:
6））!
实践证明这是正确的输出方法
enddo
回文数据若干相邻想和并比较大小
!
1.圆盘上有如图1
（1）所示的20个数。
请找出哪四个相邻的数之和为最大。
请指出他们的位置和数值。
如果是1
（2）图，又是哪四个相邻的数？
programmainimplicitnoneintegera（20）,b（23）,c（20）
integeri,j,d,edataa/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个数。
请找出哪I个相邻的数之和为最大。
请指出他们的位置和数值。
programmainimplicitnoneintegeri,j,d,eintegerk,linteger,allocatable:
:
a（:
）,b（:
）,c（:
）print*,"请输入数据的总数”read*,k
print*,"请输入求和的元素个数read*,l
allocate（a（k）,b（k+l-1）,c（k））print*,"请依次输入数据”
doi=1,kread*,a（i）enddo
doi=1,kb（i）=ienddodoi=k+1,k+l-1
b（i）=i-kenddo
doi=1,k
doj=i,i+l-1
c（i）=c（i）+a（b（j））!
一维数组嵌套的功能可由二维数组代替enddo
enddoe=1
doi=1,k-1
if（c
（1）（1）c
（1）=c（i+1）c（i+1）=de=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丄7,L8,L9,L10丄11,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
containssubroutinesub1（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
endmodulenewtonprogrammainusenewtonimplicitnone
print*,"请输入初值x:
"read*,x
callsub1（x）
print*,x
endprogrammain
牛追人问题
!
用派生定义坐标，但没有定义向量运算符
本题可以不用派生，直接定义坐标变量，应该可以简化。
精度由V的增量，时间间隔t,判定相遇的临界距离三者决定
modulemodulel
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
endfunctionsubroutinesub1（v,ra）type（vector）:
:
va,vc,ra,rc,drrealv,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
endsubroutinesubl
endmoduleprogrammain
usemodule1
implicitnone
v=0
print*,'小孩的速度应为
ra.x=10
ra.y=50dowhile（ra.x<60.0）v=v+0.1
ra.x=10
ra.y=50
callsub1（v,ra）
write（*,*）v,ra.x
enddowrite（*,*）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
endifendsubroutineprogrammainimplicitnoneintegeriinteger,target:
:
pdop=1900,2008callsub1（p）enddo
endprogrammai
最大公约数
!
辗转相除法
PROGRAMMAIN
IMPLICITNONE
INTEGERM,N
PRINT*,"请输入两个正整数”read*,M,N
print*,'他们的最大公约数为’print*,F（M,N）
contains
FUNCTIONF（M,N）integerM,N,F,I,PI=1
IF（MP=M
M=N
N=P
ENDIF
DOWHILE（I/=O）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,P1=1
DOWHILE（I/=O）IF（MM=N
N=P
ENDIF
I=M-N
梯形积分
moduleintegralimplicitnoneintegernreala,b
contains
functions（n,a,b）
integernreala,bintegerireals,hh=（b-a）/ns=0
doi=1,n,1
s=s+（f（a+h*（i-1））+f（a+h*i））/2*henddo
endfunction
functionf（x）realx,ff=exp（x）endfunction
endmoduleintegralprogrammainuseintegralimplicitnonewrite（*,*）"被积函数f=eAx，请输入积分下限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
升级会员 