西安交通大学fortran习题.doc

精品文档，仅供学习与交流，如有侵权请联系网站删除1 二维数组的输入与输出program mainimplicit noneinteger i,jinteger A(2,2)!若为data(A(j,i),i=1,2),j=1,2)/1,2,3,4/print*,Aend !结果为 1 3 2 4实际为A(1,1)=1 A(1,2)=2 A(2,1)=3 A(2,2)=4!若为data(A(i,j),i=1,2),j=1,2)/1,2,3,4/print*,Aend !结果为 1 2 3 4实际为A(1,1)=1 A(2,1)=2 A(1,2)=3 A(2,2)=4program mainimplicit noneinteger i,jinteger A(2,2)data(A(i,j),i=1,2),j=1,2)/1,2,3,4/write(*,"(I3,I3)")Aend !结果为 1 2 3 4翻卡片!用数组编写下面的题目：假定有一叠卡片，卡片号为1到52，并且所有卡片的正面朝上。从卡片号2开始，把凡是偶数的卡片都翻成正面朝下。再从3号卡片开始，把凡是卡片号为3的倍数的卡片都翻一个面（即把正面朝上的翻成正面朝下，正面朝下的翻成正面朝上）。下一步从4号卡片开始，把凡是卡片号为4的倍数的卡片都翻一个面，依次类推，直到从52号卡片开始，把凡是卡号为52的倍数的卡片翻一个面。写出一个程序，来测定全过程完成后，哪些卡片的面朝上，共有几张。答案：正面朝上的卡片是第1、4、9、16、25、36、49张，共7张。program mainimplicit none integer s(52)integer i,js=0do i=2,52j=ido while(j<=52)s(j)=s(j)+1j=j+iend doend dodo i=1,52if(mod(s(i),2)=0)thenwrite(*,*)iend ifend doend program main/用C语言写#include<stdio.h>int main()int s52;int i,j;for(i=0;i<52;i+)si=0;for(i=1;i<=51;i+)for(j=i;j<=51;j+=i+1)/ 也可以写作j=j+i+1,不能写作j=j+i+1sj=sj+1;斐波拉契!使用递归时result()不能与函数名相同PROGRAM MAINIMPLICIT NONEINTEGER n,i,sumread*,nif(n<0)THENPRINT*,"出错" END IFwrite(*,*)'f(n)=',f(n)do i=1,nsum=sum+f(n)end dowrite(*,*)'sum=',sumcontainsrecursive function f(n) result(g)integer g,nif(n=0)theng=0else if(n=1.or.n=2)theng=1elseg=f(n-1)+f(n-2)end ifend functionEnd program分解质因数!分解质因数program mainimplicit noneinteger a,c,i,bprint*,"请输入一个大于二的整数"read*,aprint*,'则它的所有质因子为'do while(a/=1)i=1b=1do while(b/=0)i=i+1b=mod(a,i)c=iend doa=a/cprint*,cend doend program哥德巴赫猜想!屏幕上不能显示500行，所以不能将结果完全显示，需要将结果输入文件FUNCTION f(i)IMPLICIT NONEINTEGER i,f,hf=0if(i>1)thendo h=2,i-1if(mod(i,h)=0)thenf=f+1endifend doendifend functionprogram mainimplicit noneinteger(4) i,j,n,finteger sdo n=4,600,2s=0j=0do i=1,n/2-1j=n-iif(f(i)=0.and.f(j)=0)thens=s+1end ifend doif(s=0)thenprint*,n,'不满足猜想'elseprint*,n,send ifend doend program 黄金值法解方程！将中值法中取中点的值改为取黄金点的值，理论上可以提高效率module golden_sectionimplicit nonereal a,b,ccontainssubroutine sub1(a,b,c)real a,b,c,ycc=(a*0.618+b)/1.618yc=f(c)do while(abs(yc)>0.00001)if(yc*f(a)<0)thenb=celsea=cend ifc=(a*0.618+b)/1.618yc=f(c)end doend subroutinefunction f(x)real f,xf=x*x-4.0*x+3end functionend module golden_sectionprogram mainuse golden_sectionimplicit nonereal eprint*,"请输入解的下界a"read*,aprint*,"请输入解的上界b"read*,be=f(a)*f(b)!用一个循环来判断输入值是否合适，或者就是解if(f(a)=0)thenprint*,aelse if(f(b)=0)thenprint*,belsedo while(e>0)print*,"f(a)=,f(a);f(b)=,f(b);请重新输入下界a"read*,aprint*,"请重新输入解的下界b"read*,bend docall sub1(a,b,c)end ifprint*,cend回文输出program mainimplicit noneinteger i,jinteger a(5),b(5)data a /1,2,8,2,10/data b /2,3,4,5,6/do i=1,5 do j=1,5 b(j)=b(j)-1 if(b(j)<1)then b(j)=b(j)+5 end if end doprint*,a(b(1:5)!实践证明这是正确的输出方法end doend! forall语句中不能使用if语句,但可以用where语句，注意（）中的内容变化但本题从逻辑上就应该先做完forall,再做where，故不必嵌套program mainimplicit noneinteger i,jinteger a(6),b(6)DATA a /1,4,9,16,25,36/data b /2,3,4,5,6,7/do i=1,6forall(j=1:6)b(j)=b(j)-1end forallwhere(b=0) !可以写为where(b(:)=0) b(:)=b(:)+6 end whereb=b+6end whereprint*,a(b(1:6)!实践证明这是正确的输出方法end do回文数据若干相邻想和并比较大小!1.圆盘上有如图1（1）所示的20个数。请找出哪四个相邻的数之和为最大。请指出他们的位置和数值。如果是1（2）图，又是哪四个相邻的数？program mainimplicit noneinteger a(20),b(23),c(20)integer i,j,d,edata a /20,21,8,4,13,6,10,15,2,17,3,19,7,16,8,11,14,9,12,5/data b /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,1,2,3/do i=1,20c(i)=a(b(i)+a(b(i+1)+a(b(i+2)+a(b(i+3)end doe=1do i=1,19 if(c(1)<c(i+1)then d=c(1) c(1)=c(i+1) c(i+1)=d e=i+1 end ifend doprint*,c(1)write(*,*)(a(b(i),i=e,e+3)end /用C语言写，注意C的数组从0开始计数，所有的i变量减一；嵌套数组仍然有效#include<stdio.h>int main()int a20=20,21,8,4,13,6,10,15,2,17,3,19,7,16,8,11,14,9,12,5;int b23=0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,0,1,2;int c20; int i,j,d,e;for(i=0;i<=18;i+)ci=abi+abi+1+abi+2+abi+3;e=0;for(i=0;i<=18;i+)if(c0<ci+1) d=c0;c0=ci+1;ci+1=d;e=i+1;printf("和最大的是%d,这四个数是：n",c0); for(i=e;i<=e+3;i+)printf("%d,",abi);return 0;!圆盘上有如图所示的K个数。请找出哪l个相邻的数之和为最大。请指出他们的位置和数值。program mainimplicit noneinteger i,j,d,einteger k,linteger,allocatable: a(:),b(:),c(:)print*,"请输入数据的总数"read*,kprint*,"请输入求和的元素个数"read*,lallocate(a(k),b(k+l-1),c(k)print*,"请依次输入数据"do i=1,kread*,a(i)end dodo i=1,kb(i)=iend dodo i=k+1,k+l-1b(i)=i-kend dodo i=1,kdo j=i,i+l-1c(i)=c(i)+a(b(j) !一维数组嵌套的功能可由二维数组代替end doend doe=1do i=1,k-1 if(c(1)<c(i+1)then d=c(1) c(1)=c(i+1) c(i+1)=d e=i+1 end ifend doprint*,'和最大为',c(1),' 这些数为'write(*,*)(a(b(i),i=e,e+l-1)end 计算六边形的面积PROGRAM MAINIMPLICIT NONEREAL AREA, L1,L2,L3,L4,L5,L6,L7,L8,L9,L10,L11,L12PRINT*,"请输入将六边形分割成三角形后各个三角形的边长"PRINT*,"第一个三角形三边为"READ*,L1,L2,L3PRINT*,"第二个三角形三边为"READ*,L4,L5,L6PRINT*,"第三个三角形三边为"READ*,L7,L8,L9PRINT*,"第四个三角形三边为"READ*,L10,L11,L12AREA=F(L1,L2,L3)+F(L4,L5,L6)+F(L7,L8,L9)+F(L10,L11,L12)write(*,*)AREACONTAINSFUNCTION F(A,B,C)REAL F,A,B,C,SS=(A+B+C)/2F=SQRT(S*(S-A)*(S-B)*(S-C)END FUNCTIONEND 计算最大公约数和最小公倍数PROGRAM MAIN!计算两个数的最小公倍数与最大公约数IMPLICIT NONEINTEGER X,Y,F,GPRINT*,"请输入两个正整数"READ*,X,YG=X*Y/F(X,Y)write(*,*)"最大公因数为",F(X,Y)write(*,*)"最小公倍数为",GEND PROGRAM MAIN!FFUNCTION F(X,Y)IMPLICIT NONEINTEGER X,Y,Z,FIF(X<Y)THEN Z=YY=XX=ZENDIFZ=X-YDO WHILE(Z/=Y)IF(Z>Y)THENX=ZELSEX=YY=ZENDIFZ=X-YEND DOF=ZEND FUNCTION牛顿法解方程!牛顿法解方程，效率高，但是方程有多解时，解对初值很敏感；另外还要求函数处处可导module newtonimplicit none real x,y,k,vcontainssubroutine sub1(x)real x,k,yreal dxdx=0.00001y=f(x)k=(f(x)-f(x-dx)/dxdo while(abs(y)>0.00001)x=x-y/k !注意方程不要解错y=f(x)end doend subroutinefunction f(x)real f,xf=x*x-4.0*x+3end functionend module newtonprogram mainuse newtonimplicit none print*,"请输入初值x:" read*,xcall sub1(x)print*,xend program main牛追人问题!用派生定义坐标，但没有定义向量运算符本题可以不用派生，直接定义坐标变量，应该可以简化。精度由v的增量，时间间隔t,判定相遇的临界距离三者决定module module1implicit nonetype vectorreal xreal yend type!下面的声明语句可以不要，但私下下认为不应省略type (vector):va,vc,ra,rc,dr !模块中定义了type后，其他例程都不用再定义但要声明变量real v,tcontainsfunction norm(r)real normtype(vector):rnorm=(r.x*r.x+r.y*r.y)*0.5end functionsubroutine sub1(v,ra)type (vector):va,vc,ra,rc,drreal v,tt=0.1ra.x=10ra.y=50rc.x=0rc.y=0vc.x=5.0/(26*0.5)vc.y=5.0/(26*0.5)*5va.x=v*2.0/(5*0.5)va.y=v*(-1.0)/(5*0.5)dr.x=ra.xdr.y=ra.y do while(norm(dr)>1) rc.x=rc.x+vc.x*trc.y=rc.y+vc.y*tra.x=ra.x+va.x*tra.y=ra.y+va.y*tdr.x=ra.x-rc.xdr.y=ra.y-rc.yvc.x=5*dr.x/(norm(dr)vc.y=5*dr.y/(norm(dr)end doend subroutine sub1end module program mainuse module1implicit nonev=0print*,'小孩的速度应为'ra.x=10ra.y=50do while(ra.x<60.0)v=v+0.1ra.x=10ra.y=50call sub1(v,ra)write(*,*)v,ra.xend dowrite(*,*)vend判断闰年subroutine sub1(p)implicit noneinteger ,target:pinteger,pointer:ainteger i,j,sif(mod(p,400)=0.or.mod(p,100)/=0.and.mod(p,4)=0)then!事实证明这么写是正确的a=>pprint*,aend ifendsubroutine program mainimplicit noneinteger iinteger ,target:pdo p=1900,2008call sub1(p)end doend program mai最大公约数!辗转相除法PROGRAM MAINIMPLICIT NONEINTEGER M,NPRINT*,"请输入两个正整数"read*,M,Nprint*,'他们的最大公约数为'print*,F(M,N)containsFUNCTION F(M,N)integer M,N,F,I,PI=1IF(M<N)THEN P=MM=NN=PEND IFDO WHILE(I/=0)I=MOD(M,N)M=NN=IEND DOF=MEND FUNCTIONEND PROGRAM!秦九韶算法PROGRAM MAINIMPLICIT NONEINTEGER M,NPRINT*,"请输入两个正整数"read*,M,Nprint*,'他们的最大公约数为'print*,F(M,N)containsFUNCTION F(M,N)integer M,N,F,I,PI=1DO WHILE(I/=0)IF(M<N)THEN P=MM=NN=PEND IFI=M-N梯形积分module integralimplicit noneinteger nreal a,bcontainsfunction s(n,a,b)integer nreal a,binteger ireal s,hh=(b-a)/ns=0 do i=1,n,1s=s+(f(a+h*(i-1)+f(a+h*i)/2*hend doend functionfunction f(x)real x,ff=exp(x)end functionend module integralprogram mainuse integralimplicit nonewrite(*,*)"被积函数f=ex，请输入积分下限a,与积分上限b:"read*,a,bwrite(*,*)"请输入n,"read*,nprint*,"积分结果为：",s(n,a,b)end program main用幂级数近似计算PROGRAM MAINIMPLICIT NONEREAL(8) X,SIN,AREAD*,XCALL ISIN(X,SIN,A)PRINT*,SINEND PROGRAMSUBROUTINE ISIN(X,SIN,A)IMPLICIT NONEREAL(8) SIN,X,AINTEGER II=0SIN=X !明确累加从何开始A=XDO WHILE(ABS(A)>=0.0000006)I=I+1A=A*(-1)*X*X/(I*2+1)/(2*I)SIN=SIN+AEND DOEND SUBROUTIN【精品文档】第 12 页