西安交通大学fortran习题

1二维数组的输入与输出

program mai n

implicit none

in teger i,j

in teger A(2,2)

!若为

data((A(j,i),i=1,2),j=1,2)/1,2,3,4/

prin t*,A

end

!结果为13 2 4

实际为A(1,1)=1 A(1,2)=2 A(2,1)=3

!若为

data((A(i,j),i=1,2),j=1,2)/1,2,3,4/

prin t*,A

end

!结果为1 2 3 4

实际为A(1,1)=1 A(2,1)=2 A(1,2)=3 program mai n

implicit none

in teger i,j

in teger A(2,2) data((A(i,j),i=1,2),j=1,2)/1,2,3,4/

write(*,"(l3,l3)")A

end

!结果为1 2

3 4

翻卡片

!用数组编写下面的题目：

假定有一叠卡片，卡片号为1到52,并且所有卡片的正面朝上。从卡片号2开始，把凡是偶数

的卡片都翻

成正面朝下。再从3号卡片开始，把凡是卡片号为3的倍数的卡片都翻一个面（即把正面朝上

的翻成正面

朝下，正面朝下的翻成正面朝上）。下一步从4号卡片开始，把凡是卡片号为4的倍数的卡片都翻一个面，

依次类推，直到从52号卡片开始，把凡是卡号为52的倍数的卡片翻一个面。写出一个程序，

来测定全过

程完成后，哪些卡片的面朝上，共有几张。

答案：正面朝上的卡片是第1、4、9、16、25、36、49张，共7张。

program main implicit none in teger s(52) in teger i,j s=0 do

i=2,52 j=i A(2,2)=4 A(2,2)=4

do while(j<=52) s(j)=s(j)+1 j=j+i end do

end do

do i=1,52

if(mod(s(i),2)==0)then write(*,*)i end if end do

end program mai n

II用C语言写

#in clude int mai n()

{

int s[52];

int i,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()不能与函数名相同

PROGRAM MAIN IMPLICIT NONE INTEGER n,i,sum read*, n if(n< 0)THEN PRINT*,"出错"

END IF

write(*,*)'f( n)=',f( n) do i=1, n sum=sum+f( n) end do write(*,*)'sum=',sum contains recursive function f(n) result(g) in teger g,n

if(n==0)the n

g=0

else if(n==1.or. n==2)the n

g=1

else

g=f( n-1)+f( n-2)

end if

end fun cti on

End program

分解质因数

!分解质因数

program mai n

implicit none

in teger a,c,i,b

print*,"请输入一个大于二的整数”

read*,a

print*,'则它的所有质因子为’

do while(a/=1)

i=1

b=1

do while(b/=0)

i=i+1

b=mod(a,i)

c=i

end do

a=a/c

prin t*,c

end do

end program

哥德巴赫猜想

!屏幕上不能显示500行，所以不能将结果完全显示，需要将结果输入文件FUNCTION f(i)

IMPLICIT NONE

INTEGER i,f,h

f=0

if(i>1)the n

do h=2,i-1

if(mod(i,h)==0)the n

f=f+1 en dif end do en dif

end fun cti on

program mai n

implicit none in teger(4) i,j, n,f in teger s

do n=4,600,2

s=0

j=0

do i=1, n/2-1

j=n_i

if(f(i)==O.a nd.f(j)==O)then s=s+1 end if

end do

if(s==0)the n

print*,n,'不满足猜想’ else

prin t*, n,s

end if

end do

end program

黄金值法解方程

!将中值法中取中点的值改为取黄金点的值，理论上可以提高效率module golde n_sect ion

implicit none

real a,b,c

contains

subrouti ne sub1(a,b,c)

real a,b,c,yc

c=(a*0.618+b)/1.618

yc=f(c)

do while(abs(yc)>0.00001)

if(yc*f(a)

b=c

else

a=c

end if

c=(a*0.618+b)/1.618 yc=f(c) end do

end subrout ine

fun ctio n f(x)

real f,x f=x*x-4.0*x+3 end fun cti on end module golde n_secti on program mai n use golde n_secti on implicit none real e

print*,"请输入解的下界a"

read*,a

print*,"请输入解的上界b"

read*,b e=f(a)*f(b)

!用一个循环来判断输入值是否合适，或者就是解

if(f(a)==0)the n

prin t*,a

else if(f(b)==0)the n

prin t*,b

else

do while(e>0)

prin t*,"f(a)=,f(a);f(b)=,f(b);请重新输入下界a" read*,a

print*,"请重新输入解的下界b"

read*,b

end do call sub1(a,b,c) end if

prin t*,c end

program mai n

implicit none

in teger i,j

in teger 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)the n

b(j)=b(j)+5

end if

end do

print*,a(b(1:5))!实践证明这是正确的输出方法

end do

end

! forall 语句中不能使用if 语句,但可以用where 语句，注意()中的内容变化 但本题从逻辑上就应该先做完 forall,再做where ，故不必嵌套 program mai n implicit none in teger i,j in teger a(6),b(6)

DATA a /1,4,9,16,25,36/ data b /2,3,4,5,6,7/ do i=1,6 forall(j=1:6) b(j)=b(j)-1 end forall

!可以写为 where(b(:)==0) b(:)=b(:)+6 end where

print*,a(b(1:6))!实践证明这是正确的输出方法

end do

回文数据若干相邻想和并比较大小

!1.圆盘上有如图1( 1)所示的20个数。请找出哪四个相邻的数之和为最大。请指出他们的位 置和数值。如果是 1( 2 )图，又是哪四个相邻的数？

program main implicit none in teger a(20),b(23),c(20)

in teger i,j,d,e data 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,20

c(i)=a(b(i))+a(b(i+1))+a(b(i+2))+a(b(i+3))

end do

e=1

do i=1,19

if(c(1)

d=c(1)

c(1)=c(i+1)

c(i+1)=d

e=i+1

end if

end do

where(b==0) b=b+6 end

where

write(*,*)(a(b(i)),i=e,e+3)

end

//用C语言写，注意C的数组从0开始计数，所有的i变量减一；嵌套数组仍然有效

#in clude

int mai n()

{

int a[20]={20,21,8,4,13,6,10,15,2,17,3,19,7,16,8,11,14,9,12,5};

int b[23]={0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,0,1,2};

int c[20];

int i,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++)

prin tf("%d,",a[b[i]]);

return 0;

}

!圆盘上有如图所示的K个数。请找出哪I个相邻的数之和为最大。请指出他们的位置和数值。

program mai n implicit none in teger i,j,d,e in teger k,l in teger,allocatable:: a(:),b(:),c(:) print*,"请输入数据的总数” read*,k

print*,"请输入求和的元素个数read*,l

allocate(a(k),b(k+l-1),c(k)) print*,"请依次输入数据”

do i=1,k read*,a(i) end do

do i=1,k b(i)=i end do do i=k+1,k+l-1

b(i)=i-k end do

do i=1,k

do j=i,i+l-1

c(i)=c(i)+a(b(j)) ! 一维数组嵌套的功能可由二维数组代替end do

end do e=1

do i=1,k-1

if(c(1)

end if

end do

print*,'和最大为',c(1),' 这些数为

write(*,*)(a(b(i)),i=e,e+l-1)

end

计算六边形的面积

PROGRAM MAIN

IMPLICIT NONE

REAL AREA, L1,L2, L3,L 4, L5,L6 丄7,L8, L9,L10 丄11, L12

PRINT*,"请输入将六边形分割成三角形后各个三角形的边长

PRINT*,"第一个三角形三边为”

READ* ,L 1,L2 ,L3

PRINT*,"第二个三角形三边为”

READ* ,L 4,L5 ,L6

PRINT*,"第三个三角形三边为”

READ*,L7, L8,L9

PRINT*,"第四个三角形三边为”

READ*,L10,L11,L12

AREA=F(L1, L2,L3)+F(L 4,L 5,L6)+F(L7 ,L 8,L9)+F(L10,L11,L12) write(*,*)AREA CONTAINS

FUNCTION F(A,B,C)

REAL F,A,B,C,S

S=(A+B+C)/2

F=SQRT(S*(S-A)*(S-B)*(S-C))

END FUNCTION

END

计算最大公约数和最小公倍数

PROGRAM MAIN

!计算两个数的最小公倍数与最大公约数

IMPLICIT NONE

INTEGER X,Y,F,G

PRINT*,"请输入两个正整数”

READ*,X,Y

G=X*Y/F(X,Y)

write(*,*)"最大公因数为”,F(X,Y)

write(*,*)"最小公倍数为",G

END PROGRAM MAIN

!F

FUNCTION F(X,Y)

IMPLICIT NONE

INTEGER X,Y,Z,F

IF(X

Z=Y

Y=X

X=Z

ENDIF

Z=X-Y

DO WHILE(Z/=Y)

IF(Z>Y)THEN

X=Z

ELSE

X=Y

Y=Z

ENDIF

Z=X-Y

END DO

F=Z

END FUNCTION

牛顿法解方程

!牛顿法解方程，效率高，但是方程有多解时，解对初值很敏感；另外还要求函数处处可导module n ewt on

implicit none

real x,y,k,v

contains subrouti ne sub1(x)

real x,k,y

real dx

dx=0.00001

y=f(x)

k=(f(x)-f(x-dx))/dx

do while(abs(y)>0.00001)

x=x-y/k !注意方程不要解错

y=f(x)

end do

end subrout ine

fun ctio n f(x)

real f,x

f=x*x-4.0*x+3

end fun cti on

end module n ewt on program mai n use n ewt on implicit none

print*,"请输入初值x:" read*,x

call sub1(x)

prin t*,x

end program mai n

牛追人问题

!用派生定义坐标，但没有定义向量运算符

本题可以不用派生，直接定义坐标变量，应该可以简化。

精度由V的增量，时间间隔t,判定相遇的临界距离三者决定

module modulel

implicit none

type vector

real x

real y

end type

!下面的声明语句可以不要，但私下下认为不应省略

type (vector)::va,vc,ra,rc,dr !模块中定义了type后，其他例程都不用再定义但要声明变量real v,t

contains

fun ctio n n orm(r)

real norm

type(vector)::r

no rm=(r.x*r.x+r.y*r.y)**0.5

end fun cti on subrout ine sub1(v,ra) type (vector)::va,vc,ra,rc,dr real v,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

do while( no rm(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/( no rm(dr))

end do

end subrouti ne subl

end module program mai n

use module1

implicit none

v=0

print*,'小孩的速度应为

ra.x=10

ra.y=50 do while(ra.x<60.0) v=v+0.1

ra.x=10

ra.y=50

call sub1(v,ra)

write(*,*)v,ra.x

end do write(*,*)v

end

判断闰年

subrouti ne sub1(p)

implicit none

in teger ,target::p

in teger,po in ter::a

in teger i,j,s

if(mod(p,400)==0.or.mod(p,100)/=0.a nd.mod(p,4)==0)the n!事实证明这么写是正确的a=>p prin t*,a

end if en dsubrout ine program mai n implicit none in teger i in teger ,target::p do p=1900,2008 call sub1(p) end do

end program mai

最大公约数

!辗转相除法

PROGRAM MAIN

IMPLICIT NONE

INTEGER M,N

PRINT*,"请输入两个正整数” read*,M,N

print*,'他们的最大公约数为’ prin t*,F(M,N)

contains

FUNCTION F(M,N) in teger M,N,F,I,P I=1

IF(M

P=M

M=N

N=P

END IF

DO WHILE(I/=O) I=MOD(M,N) M=N

N=I

END DO

F=M

END FUNCTION

END PROGRAM

!秦九韶算法

PROGRAM MAIN

IMPLICIT NONE

INTEGER M,N

PRINT*,"请输入两个正整数”

read*,M,N

print*,'他们的最大公约数为’

prin t*,F(M,N)

contains

FUNCTION F(M,N) in teger M,N,F,I,P 1=1

DO WHILE(I/=O) IF(M

M=N

N=P

END IF

I=M-N

梯形积分

module in tegral implicit none in teger n real a,b

contains

fun ctio n s( n, a,b)

in teger n real a,b in teger i real s,h h=(b-a)/n s=0

do i=1, n,1

s=s+(f(a+h*(i-1))+f(a+h*i))/2*h end do

end fun cti on

fun ctio n f(x) real x,f f=exp(x) end fun cti on

end module in tegral program main use in tegral implicit none write(*,*)"被积函数f=e A x，请输入积分下限a,与积分上限b:" read*,a,b

write(*,*)"请输入n,"

read*, n

print*,"积分结果为：",s(n,a,b)

end program mai n

用幕级数近似计算

PROGRAM MAIN

IMPLICIT NONE

REAL(8) X,SIN,A

READ*,X

CALL ISIN(X,SIN,A)

PRINT*,SIN

END PROGRAM

SUBROUTINE ISIN(X,SIN,A)

IMPLICIT NONE

REAL(8) SIN,X,A

INTEGER I

I=0

SIN=X !明确累加从何开始A=X

DO WHILE(ABS(A)>=0.0000006)

I=I+1

A=A*(-1)*X*X/(I*2+1)/(2*I)

SIN=SIN+A

END DO

END SUBROUTIN