1、精選優質文檔-傾情為你奉上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 nonein

2、teger 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的倍數的卡片翻一個面。寫出一個程序，來

3、測定全過程完成后，哪些卡片的面朝上，共有幾張。答案：正面朝上的卡片是第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

4、;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=',sumcontai

5、nsrecursive 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=i

6、end 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

7、)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

8、=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*,aels

9、e 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 i

10、f(b(j)<1)then b(j)=b(j)+5 end if end do print*,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(

11、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

12、/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>

13、;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",

14、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*,"

15、;請依次輸入數據"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

16、+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,

17、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(*,*)"最

18、大公因數為",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,

19、vcontains subroutine 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*

20、,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.

21、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

22、=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)impli

23、cit 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,NP

24、RINT*,"請輸入兩個正整數"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*,'他