常见的fortran 例题源文件.docx
《常见的fortran 例题源文件.docx》由会员分享，可在线阅读，更多相关《常见的fortran 例题源文件.docx（23页珍藏版）》请在冰豆网上搜索。
常见的fortran例题源文件
1!
求解f（x1）=x1**3-2.0*x1**2+3.0*x1+4.0的泫截法迭代过程
programmian
logicale
realf,f0,f1,f2
realx0,x1,x2
integeri
f（x1）=x1**3-2.0*x1**2+3.0*x1+4.0
e（f1,f2）=sign（f1,f2）==f1!
表示a,b同号
do
read（*,*）x1,x2
f1=f（x1）
f2=f（x2）
if（e（f1,f2））then
print*,"这不是一个有效的数"
else
exit!
只是退出这个循环而不是整个程序
endif
Enddo
!
求解过程
f0=1e32
i=0
dowhile（abs（x1-x2）>le-5.and.f0>1e-6）
x0=x2-（x2-x1）/（f2-f1）*f2!
泫截法迭代过程
f0=f（x0）
if（e（x1,x0））then
x1=x0
f1=f0
else
x2=x0
f2=f0
endif
i=i+1
write（*,"（1x,i5.5,'x0=',f10.6,'f0=',f10.6）"）i,x0,f0
enddo
!
结果
x0=（x1+x2）/2.0
write（*,"（'rootis',f10.6）"）x0
pause
end
2!
输入一个三位数调用子函数程序进行逆排序
programmain
integeri,j,m
write（*,*）,"输入一个三位数"
read*,m
m=nimabi（m）
write（*,*）m
pause
End
functionnimabi（i）
integeri,a,b,c
a=int（i/100）
b=int（（mod（i,100））/10）
c=mod（i,10）
nimabi=c*100+b*10+a!
注意结果一定存在函数名中，不然读取不到结果
End
3!
将三个数进行从小到大排列的子例行子程序
!
将三个数进行从小到大排列的内部过程
programmain
implicitnone
integera,b,c
read*,a,b,c
if（a>b）callwe（a,b）
if（b>c）callwe（b,c）
if（a>b）callwe（a,b）
print*,a,b,c
pause
Contains!
说明为内部过程
subroutinewe（i,j）
implicitnone!
数据初始化说明，对已ijk必须有，不然有隐含规则的数值
integeri,j,t
if（i>j）
t=i
i=j
j=t
end
end
programmain
implicitnone
integera,b,c
read*,a,b,c
if（a>b）callwe（a,b）
if（b>c）callwe（b,c）
if（a>b）callwe（a,b）
print*,a,b,c
pause
end
subroutinewe（i,j）
integeri,j,t
if（i>j）
t=i
i=j
j=t
end
4!
entry语句的多接入点
programmain
implicitnone
reala
print*,'输入一个数据'
read*,a
if（a>0.0）then
callsign（a）
else
callnegtive（a）
endif
PAUSE
这样的entry可以避免子程序中，重复的声明数据类型，当然可以用两个子程序来实现，但是必须申明两次，数据类型
end
subroutinesign（a）
implicitnone
reala,b
write（*,*）'这是一个正数'
b=sqrt（a）
print*,'他的平方更为：
',b
return!
还回主调程序
entrynegtive（a）
print*,'这是一个负数'
b=-abs（a）**（1./3.）
print*,'他的立方根为：
',b
return
end
5!
输入三边形或者四边形的周长，用return多折还点
programmian
implicitnone
reala,b,c,d
integeritem
do
print*,'输入多边形的边数，只限三边形和四边形'
read*,item
if（item==3）then
print*,'输入三边形的三边的边长'
read*,a,b,c
callthree（a,b,c）
elseif（item==4）then
print*,'输入四边形的边长'
read*,a,b,c,d
callfour（a,b,c,d）
else
exit
endif
enddo
end
subroutinethree（a,b,c）
implicitnone
reala,b,c,d
reals
s=a+b+c
print*,'三边形的周长是：
',s
return
entryfour（a,b,c,d）
s=a+b+c+d
print*,'四边形的周长是：
',s
return
end
6!
return的多折回点的应用
programmain
implicitnone
integerm
reals
do
print*,'输入一个正数，（负数退出）'
read*,m
if（m<0）exit
callsub（m,s,*100,*200）
print*,'就算结果',s,'[>0]'
cycle
200print*,'就算结果',s,'[<0]'!
第二个折回点
cycle
100print*,'就算结果',s,'[=0]'
cycle
enddo
end
subroutinesub（m,s,*,*）
implicitnone
integerm
reals
s=sin（real（m））
if（s>0）then
return
elseif（s<0）then
return2!
还回第2个折回点
else
return1
endif
End
7!
一个关于特殊子函数的递归调用例子（特殊子程序使用中在主程序中申明子程序名的数据类型）
programmain
implicitnone
integern,s
integersub!
申明子函数的数据类型，在recursive（特殊子程序的一种）必须申明数据类型。
!
一个关于特殊子函数的递归调用例子
programmain
implicitnone
integern,s
integersub!
申明子函数的数据类型，在recursive用必须申明。
print*,'输入阶数n：
'
read*,n
s=sub（n）
print*,n,'!
=',s
pause
end
integerrecursivefunctionsub（n）!
递归调用必须用recursive
implicitnone
integern!
递归调用
if（n<0）then
sub=-1
return
elseif（n<=1）then
sub=1
return
endif
sub=n*sub（n-1）
return
end
print*,'输入阶数n：
'
read*,n
s=sub（n）
print*,n,'!
=',s
pause
end
recursivefunctionsub（n）result（m）
implicitnone
integern,m
!
递归调用
if（n<0）then
m=-1
return
elseif（n<=1）then
m=1
return
endif
m=n*sub（n-1）
return
!
可以不用return
programmian
implicitnone
reals,i,j
print*,'输入要累加的第一个数和最后一个数字：
'
read*,i,j
s=i
callsum（s,i,j）
print*,'累加结果：
',s
pause
end
recursivesubroutinesum（s,i,j）
reals,i,j
integer,save:
:
count=0
count=count+1
print*,'地多少次调用i',count
if（i>=j）then
else
s=s+i+1
i=i+1
callsum（s,i,j）
print*,'s的值为：
',s
endif
end
8累加的数子例行子程序调用）
programmian
implicitnone
reals,i,j
print*,'输入要累加的第一个数和最后一个数字：
'
read*,i,j
s=i
callsum（s,i,j）
print*,'累加结果：
',s
pause
end
recursivesubroutinesum（s,i,j）
reals,i,j
integer,save:
:
count=0
count=count+1
print*,'地多少次调用i',count
if（i>=j）then
return
else
s=s+i+1
i=i+1
callsum（s,i,j）
print*,'s的值为：
',s
return
endif
end
programmain
implicitnone
realfun
real:
:
m（5）=（/1.0,3.0,5.0,7.0,9.0/）
realn（5）
print*,m
n=fun（m）
print*,n
pause
end
elementalrealfunctionfun（m）
implicitnone
real,intent（in）:
:
m
fun=cos（m）*sqrt（m）
end
9element属性特殊子程序的调用
programmain
implicitnone
interface
elementalrealfunctionfun（m）
implicitnone
real,intent（in）:
:
m
end
endinterface!
endinterface必须写全
real:
:
m（5）=（/1.0,3.0,5.0,7.0,9.0/）
realn（5）
print*,m
n=fun（m）
print*,n
pause
end
elementalrealfunctionfun（m）
implicitnone
real,intent（in）:
:
m
fun=cos（m）*sqrt（m）
end
10!
common语句的用法
programmain
implicitnone
reala,b
common/co/a!
也要用common进行说明
common/com/b
print*,a,b
pause
end
blockdata
implicitnone
reala,b
common/co/a!
必须是有名公共块
common/com/b
dataa/3/
datab/4/
end
11!
接口的使用
!
用接口调用子程序来计算方矩阵的对角线元素的和
!
接口的使用
!
用接口调用子程序来计算方矩阵的对角线元素的和
programmain
implicitnone
real,allocatable:
:
matrix（:
:
）
integern,i
realtrace
print*,'输入一个矩阵的维数'
read*,n
ALLOCATE（matrix（n,n））
print*,'输入数组'
doi=1,n
read*,matrix（i,1:
n）
enddo
print*,'输入数组：
'
doi=1,n
print*,matrix（i,1:
n）
enddo
print*,trace（matrix）
pause
end
functiontrace（matrix）
real,intent（in）:
:
matrix（:
:
）
integern1,n2,i
trace=0
n1=size（matrix,1）
n2=size（matrix,2）
print*,'数组大小'
m=0
print*,n1,n2
doi=1,n1
trace=trace+matrix（i,i）
enddo
end
programmain
implicitnone
interface
realfunctiontrace（matrix）
real,intent（in）:
:
matrix（:
:
）
end
endinterface
real,allocatable:
:
matrix（:
:
）
integern,i
print*,'输入一个矩阵的维数'
read*,n
ALLOCATE（matrix（n,n））
print*,'输入数组'
doi=1,n
read*,matrix（i,1:
n）
enddo
print*,'输入数组：
'
doi=1,n
print*,matrix（i,1:
n）
enddo
print*,trace（matrix）
pause
end
functiontrace（matrix）result（m）
real,intent（in）:
:
matrix（:
:
）
realm
integern1,n2,i
n1=size（matrix,1）
n2=size（matrix,2）
print*,'数组大小'
m=0
print*,n1,n2
doi=1,n1
m=m+matrix（i,i）
enddo
end
11顺序文件的操作
moduletypedef
typestudent
integerchinese,english,math
endtype
endmodule
programmain
usetypedef
type（student）,allocatable:
:
s（:
）
integerstudents
character（30）nihao
logicalalive
character（20）filename
write（*,*）'filename'
read（*,*）filename
print*,'输入学生人数'
read（*,*）students
allocate（s（students）,stat=i）
if（i/=0）then
print*,'allocateisfail'
stop
endif
inquire（file=filename,exist=alive）
if（alive）then
open（10,file=filename,status='replace',access='sequential'）
doJ=1,students
write（*,*）'输入第位同学的学号以及成绩',i
read（*,*）s（J）
write（10,"（'学号',i2,/,3i3）"）J,s（J）
enddo
endif
pause
End
12直接文件操作
PROGRAMMAIN
logicalalive
realpo,pit
open（20,file='list.txt',access='direct',form='formatted',recl=9,status='replace'）
doi=1,3
print*,'输入原始数据;'
read（*,*）po
write（20,fmt="（f4.2）",rec=i）po
enddo
close（20）
inquire（file='list.txt',exist=alive）
if（.not.alive）then
print*,'list.txtisnotexist'
stop
endif
open（10,file='list.txt',recl=9,access='direct',form='formatted',status='old'）
dowhile（.true.）
read（*,*）i
read（10,rec=i,fmt="（f4.2）",iostat=n）pit
if（n/=0）exit
print*,pit
enddo
close（10）
pause
end
13顺序文件读写操作
PROGRAMMAIN
real:
:
a（6）=（/3.5,4.6,7.8,12.4,23,734.6/）
open（10,file='nihao.txt',access='direct',form='formatted',recl=12）
doi=1,6
write（10,fmt='（f8.3,//）',rec=i）a（i）
enddo
close（10）
pause
End
14内部文件操作，可以检验输入的数是不是数据
PROGRAMMAIN
integera
character（20）:
:
b='123'
read（b,*）a
print*,a
pause
end
15输入的只是数字
PROGRAMMAIN
integera
integer,external:
:
gen
a=gen（）
print*,a
pause
end
integerfunctiongen（）
character（10）string
logical:
:
nihao=.true.
dowhile（nihao）
print*,'输入实数：
'
read（*,'（a10）'）string
nihao=.false.
doi=1,len_trim（string）
code=ichar（string（i:
i））
if（codeichar（'9'））then
nihao=.true.
exit
endif
enddo
enddo
read（string,*）gen
END
16指针找出最小数
programmain
integer,target:
:
A（8）=（/10,15,8,25,9,20,17,19/）
integer,pointer:
:
P（:
）
INTERFACE
FUNCTIONGETMIN（P）
INTEGER,POINTER:
:
P（:
）
INTEGER,POINTER:
:
GETMIN
ENDFUNCTION
ENDINTERFACE
P=>A（1:
8:
2）
PRINT*,GETMIN（P）
PAUSE
END
FUNCTIONGETMIN（P）
INTEGER,POINTER:
:
P（:
）
INTEGER,POINTER:
:
GETMIN
S=SIZE（P,1）
MIN=2**30
DOI=1,S
IF（MIN>P（I））THEN
MIN=P（I）
GETMIN=>P（I）
ENDIF
ENDDO
RETURN
END
升级会员 