年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-2-24
一、 实验目的：练习使用Visual Fortran，练习新建、代码输入、编
译、运行操作。
二、 实验要求：使用Visual Fortran进行操作，通过一个小程序练习
操作。
三、 实验结果及分析
（1） 新建项目文件：file—new—在project中选择“fortran console
application”—
在“files”中选择自由格式的Fortran文件—输入文件名称，选择位置—ok
（2）输入程序：program e1
implicit none
write(*,*) "你好！"
stop
end
（3）依次进行编译和连接，然后运行程序。
（4）运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 输入输出和声明语句 实验日期 2012-3-2
一、 实验目的：练习fortran语言中的输入输出和声明语句的使用 二、 实验要求：阅读书上例题并调试运行
三、 实验结果及分析
program e41
implicit none
integer a real b complex c logical d character*(20) e a=10 b=12.34 c=(1,2) d=.true. e="fortran" write(*,100) a 运行结果： write(*,200) b write(*,300) c write(*,400) d write(*,500) e 100 format(1x,i5) 200 format(1x,f5.2) 300 format(1x,f4.1,f4.1) 400 format(1x,l3)
500 format(1x,a10)
End
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 输入输出和声明语句 实验日期 2012-3-9
一、 实验目的：练习fortran语言中的输入输出和声明语句的使用
二、 实验要求：完成第四章课后习题。
三、 实验结果及分析
（1）program t0401 运行结果：
write(*,*) "Have a good time."
write(*,*) "That's not bad."
write(*,*) """Mary""isn't my name."
stop
end
（2）program t0402 运行结果：
real r,mj,zc
write(*,*)"请输入圆的半径" read(*,*) r pai=3.14 mj=r*r*pai zc=2*pai*r write(*,*) "圆的面积是：",mj write(*,*) "圆的周长是：",zc
stop
end program t0402
（3）program t0403 运行结果：
real cs,tz write(*,*)"请输入一名学生的成绩：" read(*,*)cs tz=sqrt(cs)*10 write(*,*)"这名学生调整过后的成绩为：
",tz
stop
end program t0403
（4）program t0401 运行结果：
real ra,rb
integer a,b
a=2
b=3
ra=2.0
rb=3.0
write(*,*) b/a 整型变量只保留数值的整数位，小数部分舍去。
write(*,*) rb/ra
stop
end
（5）program t0405 运行结果：
implicit none
type distance real cm real m real inch end type distance write(*,*)"请输入公尺数：" read(*,*),a%m a%cm=a%m*100 a%inch=a%cm/2.54 write(*,*)"米数：",a%m write(*,*)"厘米数：",a%cm write(*,*)"英寸数：",a%inch stop type(distance) a end program t0405
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-3-16
一、 实验目的：练习fortran中选择、判断、分支语句的写法。
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析
program e51
implicit none
integer score
character grade
read(*,*) score
if ( score>=90 .and. score
grade='A'
else if ( score>=80 .and. score
grade='B'
else if ( score>=70 .and. score
grade='C'
else if ( score>=60 .and. score
grade='D'
else if ( score>=0 .and. score
grade='E'
else
grade='?'
end if
write(*,"('Grade:',A1)") grade
stop
end write(*,*) "Score:" 运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-3-23
一、 实验目的：练习fortran中选择、判断、分支语句的写法。
二、 实验要求：完成第五章习题
三、 实验结果及分析
（1）program e0501 运行结果：
implicit none
end
（2）program e0502 运行结果：
implicit none
integer a character(len=10) b write(*,*),"请输入星期号：" read(*,*),a real shou,lv,shui write(*,*),"请输入收入：" read(*,*),shou if(shou=1000.and.shou
if(a==1.or.a==4)then
b="新闻"
elseif(a==2.or.a==5)then
b="电视剧"
elseif(a==3.or.a==6)then
b="卡通片"
else
b="电影"
end if
write(*,*),"这天晚上的电视节目：",b
stop
end
（3）program e0503 运行结果：
implicit none
real shou,lv,shui
integer old
write(*,*),"请输入年龄："
read(*,*),old
write(*,*),"请输入收入："
read(*,*),shou
if(old
if(shou
lv=0.03
elseif(shou>=1000.and.shou
lv=0.1
else
lv=0.15
end if
elseif(old>=50)then
if(shou
lv=0.05
elseif(shou>=1000.and.shou
lv=0.07
else
lv=0.1
end if
end if
shui=shou*lv
write(*,*),"所应交税额为："
write(*,*),shui
stop
end
（4）program e0504 运行结果：
implicit none
integer nian,tian
tian=365
write(*,*),"请输入年数："
read(*,*),nian
if(mod(nian,4)==0.and.mod(nian,100)/=0)then
tian=366
endif
if(mod(nian,400)==0)then
tian=366
endif
write(*,*),"这一年的天数为：",tian
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 循环语句 实验日期 2012-3-30
一、 实验目的：练习循环语句
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析
program e61
implicit none
real a,b,ans
character :: key = 'y'
do while( key=='y' .or. key=='Y' )
read(*,*) a
read(*,"(A1)") key
read(*,*) b
select case(key) 运行结果：
case('+')
ans = a+b
case('-')
ans = a-b
case('*')
ans = a*b
case('/')
ans = a/b
case default
write(*,"('Unknown operator ',A1)") key
stop
end select
write(*,"(F6.2,A1,F6.2,'=',F6.2)") a,key,b,ans
write(*,*) "(Y/y) to do again. (Other) to exit."
read(*,"(A1)") key
end do
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 循环语句 实验日期 2012-4-6
一、 实验目的：练习循环语句
二、 实验要求：完成第六章课后习题
三、 实验结果及分析
（1）program e0601 运行结果：
implicit none
integer i
do i=1,5,1
write(*,*) "孟令健"
end do
stop
end
（2）program e0602 运行结果：
implicit none
integer i,sum
sum=0
do i=1,99,2
sum=sum+i
end do
write(*,*) sum
stop
end
（3）program e0603 运行结果：
implicit none
integer i
real tz,e,guess
e=0.001
tz=45
guess=0
do i=1,5,1
write(*,*) "您还有",6-i,"次机会，请输入："
read(*,*) guess
if(abs(guess-tz)
exit
end if
end do
if(i
write(*,*) "猜对了"
else
write(*,*) "猜错了"
end if
stop
end
（4）program e0604 运行结果：
integer i
real ::sum=0,fm=1
do i=1,10,1
fm=fm*i
sum=sum+1/fm
end do
print *,"结果是：",sum
end
（5）program e0605 运行结果：
implicit none
integer n,i,j
character(len=50) string,string2
write(*,*) "请输入一段字符串："
read(*,100) string
100 format(a50)
n=len(string)
j=1
i=1
do j=1,n
if(string(j:j)/=' ') then
string2(i:i)=string(j:j)
i=i+1
end if
end do
write(*,*) string2
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 数组 实验日期 2012-4-13
一、 实验目的：练习数组操作语句
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析
program ex0719
implicit none
integer, parameter :: L=3, M=4, N=2
real :: A(L,M) = (/ 1,2,3,4,5,6,7,8,9,10,11,12 /)
real :: B(M,N) = (/ 1,2,3,4,5,6,7,8 /)
real :: C(L,N)
integer :: i,j,k
do i=1,L
do j=1,N
C(i,j) = 0.0
do k=1,M
C(i,j) = C(i,j)+A(i,k)*B(k,j)
end do
end do
end do
do i=1,L
write(*,*) C(i,:)
end do
stop
end 运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 数组 实验日期 2012-4-20
一、 实验目的：练习数组操作语句
二、 实验要求：完成第七章课后习题
三、 实验结果及分析
（1）program e0701
implicit none
integer i
integer :: a(10)=(/(i,i=1,10)/)
write(*,*) (a(i),i=1,10)
stop
end
运行结果：
（2）program e0703
implicit none integer i integer f(0:10) f(0)=0 f(1)=1 do i=2,10 f(i)=f(i-1)+f(i-2) end do write(*,*) (f(i),i=0,10) stop end
运行结果：
（3）program e0704
implicit none
integer :: a(10)=(/5,7,1,8,3,9,2,0,4,6/)
integer i,j,t
write(*,*) "排序前的数组："
write(*,"(i5)\") (a(i),i=1,10)
write(*,*) "请输入需要的排序方式（1、从大到小，2、从小到大）" read(*,*) t
if(t==1)then 运行结果：
do i=1,9
do j=i+1,10
if(a(j)>a(i)) then
t=a(i)
a(i)=a(j)
a(j)=t
end if
end do
end do
else
do i=1,9
do j=i+1,10
if(a(j)
t=a(i)
a(i)=a(j)
a(j)=t
end if
end do
end do
end if
write(*,*)"排序后的数组为："
write(*,"(i5)\") (a(i),i=1,10)
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 函数 实验日期 2012-4-27
一、 实验目的：练习两种函数定义和使用语句
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析（1）program e81
implicit none
real a
real b
real add
read(*,*)a,b
write(*,*) add(a,b)
stop
end 运行结果：
function add(a,b)
implicit none
real a,b,add
add=a+b
return
end
（2）program ex0805
implicit none
integer :: a = 1
integer :: b = 2
write(*,*) a,b
call add(a)
call add(b)
write(*,*) a,b
stop
end 运行结果：
subroutine add(num)
implicit none
integer :: num
num = num+1
return
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 函数 实验日期 2012-5-4
一、 实验目的：练习两种函数定义和使用语句
二、 实验要求：完成第八章课后习题
三、 实验结果及分析
（1）program e0801 运行结果：
implicit none
real r,s
write(*,*)"请输入半径："
read(*,*) r
call mj(r,s)
write(*,*)"圆的面积是：",s
stop
end program e0801
subroutine mj(r,s)
implicit none
real r,s
s=3.14*r*r
return
end subroutine mj
（2）program e0802 运行结果：
implicit none
real r,s
real,external :: mj
write(*,*) "请输入半径："
read(*,*) r
s=mj(r)
write(*,*) "圆的面积是：",s
stop
end
function mj(r)
implicit none
real mj,r
mj=3.14*r*r
return
end function mj
（3）program e0803 运行结果：
implicit none
integer i
write(*,*)"请输入参数"
read(*,*)i
call xh(i)
stop
end program e0803
subroutine xh(i)
implicit none
100 format(a1,\)
integer i,j
do j=1,i
write(*,100)"*"
if(j==i) then
write(*,'(/)')
end if
end do
end subroutine xh
（4）program e0804
implicit none
integer,external :: dg
integer n,s
read(*,*)n
s=dg(n)
write(*,*)s
stop
end
recursive function dg(n)
implicit none
integer dg,n
dg=n
if(n>=2) then
dg=dg+dg(n-1)
else
return
end if 运行结果：
end
（5）program e0805 运行结果：
implicit none
integer m,n,t
integer,external :: gys
write(*,*)"请输入m和n："
read(*,"(1i,1i)")m,n
t=gys(m,n)
write(*,*)"最大公约数是：",t
stop
end
function gys(m,n,t)
implicit none
integer m,n,gys,r,t
if(n
t=n
n=m
m=t
end If
r=mod(m,n)
do While(r/=0)
m=n
n=r
r=mod(m,n)
end do
gys=n
return
end function gys
河北大学工商学院Fortran程序设计实验报告
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 综合练习 实验日期 2012-5-11
一、 实验目的：通过计算内力的小型程序练习之前的学习内容
二、 实验要求：完成调试并运行程序
三、 实验结果及分析
program neili
implicit none
integer xz,i,j,k,n ! 定义变量
character sc,jc
real f(0:15),x(0:15),l,fa,fb,fs,wz,m,fp
i=0
write(*,*)"请输入F的个数："
read(*,*) n
do i=1,n,1
write(*,*)"请输入F的值："
read(*,*) f(i)
write(*,*)"请输入F的作用位置："
read(*,*) x(i)
end do
write(*,*)"请输入杆的长度："
read(*,*) l
write(*,*)"请输入所要查询的位置："
read(*,*) wz
write(*,*)"请检查数据：" !输出检查数据
do j=1,n,1
write(*,100) j,f(j),x(j)
end do
100 format('F',i1,'=',f5.2,';','作用位置：',f5.2)
write(*,200) l
200 format("梁的总长为：",f5.2)
write(*,*)"是否正确？（Y or N）" !判断是否正确
read(*,*) jc
if(jc=="Y".or.jc=="y") then
do j=1,n,1 !计算过程 fb=fb+f(j)*x(j)
end do
fb=fb/l do j=1,n,1
fa=fa+f(j)
end do
fa=fa-fb
do j=1,i,1
if(wzx(j-1)) then
do k=0,j-1,1
fs=fa-f(k)
end do
end if
end do
fp=fa
m=0
do j=1,n,1
if(wzx(j-1)) then
k=j
end if
end do
if(k==1)then
m=fa*wz
else
do j=1,k-1,1
m=m+fp*(x(j)-x(j-1))
fp=fp-f(j)
end do
m=m+fp*(wz-x(j))
end if
write(*,300) wz,fs,m !输出结果
300 format(f5.2,"位置的剪力为：",f5.2,"弯矩为：",f5.2) end if
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 文件操作 实验日期 2012-5-18
一、 实验目的：练习fortran的文件操作
二、 实验要求：编制小程序，练习文件读写操作
三、 实验结果及分析
program e0901
implicit none
integer a,b,c,d,i
open(1,file="E:\输入.txt")
read(1,*) a,b,c,d
open(2,file="E:\输出.txt")
write(2,100) d,c,b,a
write(*,*) "成功！！！"
100 format(i1,i1,i1,i1)
stop
end
运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 文件操作 实验日期 2012-5-25
一、 实验目的：练习文件操作语句
二、 实验要求：改写上一个内力程序，添加文件操作
三、 实验结果及分析
program neili
implicit none
integer xz,i,j,k,n ! 定义变量 character sc,jc
real f(0:15),x(0:15),l,fa,fb,fs,fp,wz,m
i=0
write(*,*) "请选择数据的输入方式：（1：手动输入；2：文件输入）" !选择输入方式
read(*,*) xz
if(xz==1) then ! 手动输入
write(*,*)"请输入F的个数："
read(*,*) n
do i=1,n,1
write(*,*)"请输入F的值："
read(*,*) f(i)
write(*,*)"请输入F的作用位置："
read(*,*) x(i)
end do
write(*,*)"请输入杆的长度："
read(*,*) l
write(*,*)"请输入所要查询的位置："
read(*,*) wz
else if(xz==2) then ! 文件输入，文件保存在E:\输入.txt write(*,*)"请输入F的个数："
open(1,file="E:\输入.txt")
read(*,*) n
do i=1,n,1
read(1,*)f(i),x(i)
end do
read(1,*)l
write(*,*)"请输入所要查询的位置："
read(*,*) wz
end if
write(*,*)"请检查数据：" !输出检查数据
do j=1,n,1
write(*,100) j,f(j),x(j)
end do
100 format('F',i1,'=',f5.2,';','作用位置：',f5.2)
write(*,200) l
200 format("梁的总长为：",f5.2)
write(*,*)"是否正确？（Y or N）"
read(*,*) jc
if(jc=="Y".or.jc=="y") then
do j=1,n,1
fb=fb+f(j)*x(j)
end do
fb=fb/l
do j=1,n,1
fa=fa+f(j)
end do
fa=fa-fb
fs=fa
do j=1,i,1
if(wzx(j-1)) then
do k=1,j-1,1
fs=fs-f(k)
end do
end if
end do
fp=fa
m=0
do j=1,n,1
if(wzx(j-1)) then
k=j
end if
end do
if(k==1)then
m=fa*wz
else
do j=1,k-1,1
m=m+fp*(x(j)-x(j-1))
fp=fp-f(j) !判断是否正确计算过程 !
end do
m=m+fp*(wz-x(j))
end if
write(*,300) wz,fs,m !输出结果 300 format(f5.2,"位置的剪力为：",f5.2,"弯矩为：",f5.2)
write(*,*)"是否把计算结果输出到文件？（Y or N）:"
read(*,*) sc
if(sc=="y".or."Y") then
open(unit=2,file="E:\输出.txt")
do j=1,n,1
write(2,100) j,f(j),x(j)
end do
write(2,200) l
write(2,300) wz,fs,m
write(*,*)"文件已保存到“E:\输出.txt”"
end if
end if
stop
end 运行结果：
输入文件内容：
输出文件：
河北大学工商学院Fortran程序设计实验报告
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 综合练习 实验日期 2012-6-1
一、 实验目的：综合练习学习的内容，练习编制较复杂的程序
二、 实验要求：编写一个高斯消元解多元方程组的程序
三、 实验结果及分析
program fangchengzu
implicit none
integer n,i,j,k,z
character jc,wj
real er(0:15,0:15),yi(0:15),x(0:15),b,lj,er1(0:15,0:15),yi1(0:15)
integer,external :: da
lj=0
write(*,*) "请选择数据的输入方式：（1：手动输入；2：文件输入）" !选择输入方式 read(*,*) i
if(i==1) then
write(*,*)"请输入未知量的个数："
read(*,*) n
100 format("请输入第",i2,"个方程组的自由项")
200 format("请输入第",i2,"个方程组的第",i2,"个系数")
do i=1,n,i
write(*,100) i
read(*,*) yi(i) 输入文件内容： end do
do i=1,n,1
do j=1,n,1
write(*,200) i,j
end do
end do
else
open(1,file="E:\输入.txt")
write(*,*)"请输入未知量的个数："
read(*,*) n
do i=1,n,1
read(1,*)er(i,j)
end do
read(1,*)yi(i)
end do
end if
write(*,*)"请确认方程组是否正确："
300 format(f7.4,"x",i1,\)
400 format("=",f7.4)
do i=1,n,1
do j=1,n,1
write(*,300) er(i,j),j
if(j
write(*,"(1a,\)")"+"
end if
end do
write(*,400) yi(i)
end do
write(*,*)"是否正确？？？（Y/N）"
read(*,*) jc
if(jc=='Y'.or.jc=='y') then
er1=er
yi1=yi
do k=1,n-1,1
z=da(k,n,er)
call huan(z,k,n,yi,er)
do i=k+1,n,1
b=er(i,k)/er(k,k)
do j=1,n,1
er(i,j)=er(i,j)-b*er(k,j)
end do
yi(i)=yi(i)-b*yi(k)
end do
x(n)=yi(n)/er(n,n)
do i=n-1,1,-1
do j=n,i+1,-1
lj=lj+er(i,j)*x(j)
end do
x(i)=(yi(i)-lj)/er(i,i)
lj=0
end do
end do
write(*,*)"方程组的解为："
500 format('x',i1,'=',f9.6)
write(*,500) i,x(i)
end do
write(*,*)"是否把计算结果输出到文件？？？（Y/N）"
read(*,*) wj
if(wj=='y'.or.'Y')then
open(2,file="E:\输出.txt")
write(2,*)"原方程组为："
do i=1,n,1
do j=1,n,1
write(2,300) er1(i,j),j
if(j
write(2,"(1a,\)")"+"
end if
end do
write(2,400) yi1(i)
end do
write(2,*)"方程组的解为："
do i=1,n,1
write(2,500) i,x(i)
end do
write(*,*)"文件已保存到“E:\输出.txt”！"
end if
end if
stop
end
!函数部分
function da(j,n,er) !选取列主元函数
implicit none
integer i,x,j,n,da
real er(15,15),max
max=er(j,j)
do i=j,n,1
if(er(i,j)>max) then
max=er(i,j)
end if
end do
do i=j,n,1
if(er(i,j)==max) then
x=i
end if
end do
da=x
return
end
subroutine huan(x,y,n,yi,er) ！行变换函数
implicit none
integer i,x,y,n
real yi(0:15),er(0:15,0:15),zhong
do i=1,n,1
zhong=er(x,i)
er(x,i)=er(y,i)
er(y,i)=zhong
end do
zhong=yi(x)
yi(x)=yi(y)
yi(y)=zhong
end
运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-6-8
一、 实验目的：综合练习
二、 实验要求：练习使用VB调用Fortran
三、 实验结果及分析
Fortran部分：
subroutine fengya(v,h,b,f,p,jd)
!DEC$ ATTRIBUTES DLLEXPORT :: FENGYA
!DEC$ ATTRIBUTES ALIAS : "fengya" :: FENGYA
implicit none
real v,h,b,f,s,p
real jd
s=h*b
f=v*v*cos(jd)*s*1.205/1000
p=f/s
return
stop
end
VB部分：
Private Declare Sub fengya Lib "E:\fengya\Debug\fengya.dll" (v As Single, h As Single, b As Single, f As Single, p As Single, jd As Single)
Private Sub Command1_Click()
Dim p As Single
Dim f As Single
v = Val(Text4.Text)
jd = Val(Text3.Text)
h = Val(Text2.Text)
b = Val(Text1.Text)
Call fengya(v, h, b, f, p, jd)
Text5.Text = f
Text6.Text = p * 1000
End Sub
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 综合练习 实验日期 2012-6-15
一、 实验目的：练习使用VB调用fortran程序
二、 实验要求：改写计算简支梁内力程序，通过VB建立友好的使
用界面
三、 实验结果及分析
Fortran部分：
subroutine neili(f,x,m,n,wz,l,fs)
!DEC$ ATTRIBUTES DLLEXPORT :: NEILI
!DEC$ ATTRIBUTES ALIAS : "neili" :: NEILI
implicit none
integer i,j,k,n ! 定义变量
real f(0:15),x(0:15),l,fa,fb,fs,fp,wz,m
i=0
do j=1,n,1 !计算过程
fb=fb+f(j)*x(j)
end do
fb=fb/l
do j=1,n,1
fa=fa+f(j) DLL文件：
end do
fa=fa-fb
fs=fa
do j=1,n,1
if(wzx(j-1)) then
do k=1,j-1,1
fs=fs-f(k)
end do
end if
end do
fp=fa
m=0
do j=1,n,1
if(wzx(j-1)) then
k=j
end if
end do
if(k==1)then
m=fa*wz
else
do j=1,k-1,1
m=m+fp*(x(j)-x(j-1))
fp=fp-f(j)
end do
m=m+fp*(wz-x(j))
end if
return
end
VB部分：
Private Declare Sub neili Lib "E:\neili\neili\Debug\neili.dll" (f As Single, x As Single, m As Single, n As Integer, wz As Single, l As Single, fs As Single)
Private Sub Command1_Click()
Dim x(0 To 15) As Single
Dim f(0 To 15) As Single
Dim l As Single
Dim wz As Single
Dim n As Integer
Dim fs As Single
Dim m As Single
Dim r As String
l = Val(Text1.Text)
wz = Val(Text2.Text)
x(0) = 0
f(0) = 0
If Option1.Value = True Then
n = InputBox("请输入外力的数量")
For i = 1 To n
f(i) = InputBox("请输入第" & i & "个外力的大小")
x(i) = InputBox("请输入第" & i & "个外力的作用点")
Next i
Else
n = InputBox("请输入外力的数量")
CommonDialog1.Filter = "文本文件(*.txt)|*.txt"
CommonDialog1.ShowOpen
r = CommonDialog1.FileName
Open r For Input As #1
For i = 1 To n
Input #1, f(i), x(i)
Next i
Close #1
End If
Call neili(f(0), x(0), m, n, wz, l, fs)
Label3.Caption = "剪力：" & fs & "，弯矩：" & m End Sub
输入文件不变，运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-2-24
一、 实验目的：练习使用Visual Fortran，练习新建、代码输入、编
译、运行操作。
二、 实验要求：使用Visual Fortran进行操作，通过一个小程序练习
操作。
三、 实验结果及分析
（1） 新建项目文件：file—new—在project中选择“fortran console
application”—
在“files”中选择自由格式的Fortran文件—输入文件名称，选择位置—ok
（2）输入程序：program e1
implicit none
write(*,*) "你好！"
stop
end
（3）依次进行编译和连接，然后运行程序。
（4）运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 输入输出和声明语句 实验日期 2012-3-2
一、 实验目的：练习fortran语言中的输入输出和声明语句的使用 二、 实验要求：阅读书上例题并调试运行
三、 实验结果及分析
program e41
implicit none
integer a real b complex c logical d character*(20) e a=10 b=12.34 c=(1,2) d=.true. e="fortran" write(*,100) a 运行结果： write(*,200) b write(*,300) c write(*,400) d write(*,500) e 100 format(1x,i5) 200 format(1x,f5.2) 300 format(1x,f4.1,f4.1) 400 format(1x,l3)
500 format(1x,a10)
End
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 输入输出和声明语句 实验日期 2012-3-9
一、 实验目的：练习fortran语言中的输入输出和声明语句的使用
二、 实验要求：完成第四章课后习题。
三、 实验结果及分析
（1）program t0401 运行结果：
write(*,*) "Have a good time."
write(*,*) "That's not bad."
write(*,*) """Mary""isn't my name."
stop
end
（2）program t0402 运行结果：
real r,mj,zc
write(*,*)"请输入圆的半径" read(*,*) r pai=3.14 mj=r*r*pai zc=2*pai*r write(*,*) "圆的面积是：",mj write(*,*) "圆的周长是：",zc
stop
end program t0402
（3）program t0403 运行结果：
real cs,tz write(*,*)"请输入一名学生的成绩：" read(*,*)cs tz=sqrt(cs)*10 write(*,*)"这名学生调整过后的成绩为：
",tz
stop
end program t0403
（4）program t0401 运行结果：
real ra,rb
integer a,b
a=2
b=3
ra=2.0
rb=3.0
write(*,*) b/a 整型变量只保留数值的整数位，小数部分舍去。
write(*,*) rb/ra
stop
end
（5）program t0405 运行结果：
implicit none
type distance real cm real m real inch end type distance write(*,*)"请输入公尺数：" read(*,*),a%m a%cm=a%m*100 a%inch=a%cm/2.54 write(*,*)"米数：",a%m write(*,*)"厘米数：",a%cm write(*,*)"英寸数：",a%inch stop type(distance) a end program t0405
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-3-16
一、 实验目的：练习fortran中选择、判断、分支语句的写法。
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析
program e51
implicit none
integer score
character grade
read(*,*) score
if ( score>=90 .and. score
grade='A'
else if ( score>=80 .and. score
grade='B'
else if ( score>=70 .and. score
grade='C'
else if ( score>=60 .and. score
grade='D'
else if ( score>=0 .and. score
grade='E'
else
grade='?'
end if
write(*,"('Grade:',A1)") grade
stop
end write(*,*) "Score:" 运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-3-23
一、 实验目的：练习fortran中选择、判断、分支语句的写法。
二、 实验要求：完成第五章习题
三、 实验结果及分析
（1）program e0501 运行结果：
implicit none
end
（2）program e0502 运行结果：
implicit none
integer a character(len=10) b write(*,*),"请输入星期号：" read(*,*),a real shou,lv,shui write(*,*),"请输入收入：" read(*,*),shou if(shou=1000.and.shou
if(a==1.or.a==4)then
b="新闻"
elseif(a==2.or.a==5)then
b="电视剧"
elseif(a==3.or.a==6)then
b="卡通片"
else
b="电影"
end if
write(*,*),"这天晚上的电视节目：",b
stop
end
（3）program e0503 运行结果：
implicit none
real shou,lv,shui
integer old
write(*,*),"请输入年龄："
read(*,*),old
write(*,*),"请输入收入："
read(*,*),shou
if(old
if(shou
lv=0.03
elseif(shou>=1000.and.shou
lv=0.1
else
lv=0.15
end if
elseif(old>=50)then
if(shou
lv=0.05
elseif(shou>=1000.and.shou
lv=0.07
else
lv=0.1
end if
end if
shui=shou*lv
write(*,*),"所应交税额为："
write(*,*),shui
stop
end
（4）program e0504 运行结果：
implicit none
integer nian,tian
tian=365
write(*,*),"请输入年数："
read(*,*),nian
if(mod(nian,4)==0.and.mod(nian,100)/=0)then
tian=366
endif
if(mod(nian,400)==0)then
tian=366
endif
write(*,*),"这一年的天数为：",tian
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 循环语句 实验日期 2012-3-30
一、 实验目的：练习循环语句
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析
program e61
implicit none
real a,b,ans
character :: key = 'y'
do while( key=='y' .or. key=='Y' )
read(*,*) a
read(*,"(A1)") key
read(*,*) b
select case(key) 运行结果：
case('+')
ans = a+b
case('-')
ans = a-b
case('*')
ans = a*b
case('/')
ans = a/b
case default
write(*,"('Unknown operator ',A1)") key
stop
end select
write(*,"(F6.2,A1,F6.2,'=',F6.2)") a,key,b,ans
write(*,*) "(Y/y) to do again. (Other) to exit."
read(*,"(A1)") key
end do
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 循环语句 实验日期 2012-4-6
一、 实验目的：练习循环语句
二、 实验要求：完成第六章课后习题
三、 实验结果及分析
（1）program e0601 运行结果：
implicit none
integer i
do i=1,5,1
write(*,*) "孟令健"
end do
stop
end
（2）program e0602 运行结果：
implicit none
integer i,sum
sum=0
do i=1,99,2
sum=sum+i
end do
write(*,*) sum
stop
end
（3）program e0603 运行结果：
implicit none
integer i
real tz,e,guess
e=0.001
tz=45
guess=0
do i=1,5,1
write(*,*) "您还有",6-i,"次机会，请输入："
read(*,*) guess
if(abs(guess-tz)
exit
end if
end do
if(i
write(*,*) "猜对了"
else
write(*,*) "猜错了"
end if
stop
end
（4）program e0604 运行结果：
integer i
real ::sum=0,fm=1
do i=1,10,1
fm=fm*i
sum=sum+1/fm
end do
print *,"结果是：",sum
end
（5）program e0605 运行结果：
implicit none
integer n,i,j
character(len=50) string,string2
write(*,*) "请输入一段字符串："
read(*,100) string
100 format(a50)
n=len(string)
j=1
i=1
do j=1,n
if(string(j:j)/=' ') then
string2(i:i)=string(j:j)
i=i+1
end if
end do
write(*,*) string2
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 数组 实验日期 2012-4-13
一、 实验目的：练习数组操作语句
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析
program ex0719
implicit none
integer, parameter :: L=3, M=4, N=2
real :: A(L,M) = (/ 1,2,3,4,5,6,7,8,9,10,11,12 /)
real :: B(M,N) = (/ 1,2,3,4,5,6,7,8 /)
real :: C(L,N)
integer :: i,j,k
do i=1,L
do j=1,N
C(i,j) = 0.0
do k=1,M
C(i,j) = C(i,j)+A(i,k)*B(k,j)
end do
end do
end do
do i=1,L
write(*,*) C(i,:)
end do
stop
end 运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 数组 实验日期 2012-4-20
一、 实验目的：练习数组操作语句
二、 实验要求：完成第七章课后习题
三、 实验结果及分析
（1）program e0701
implicit none
integer i
integer :: a(10)=(/(i,i=1,10)/)
write(*,*) (a(i),i=1,10)
stop
end
运行结果：
（2）program e0703
implicit none integer i integer f(0:10) f(0)=0 f(1)=1 do i=2,10 f(i)=f(i-1)+f(i-2) end do write(*,*) (f(i),i=0,10) stop end
运行结果：
（3）program e0704
implicit none
integer :: a(10)=(/5,7,1,8,3,9,2,0,4,6/)
integer i,j,t
write(*,*) "排序前的数组："
write(*,"(i5)\") (a(i),i=1,10)
write(*,*) "请输入需要的排序方式（1、从大到小，2、从小到大）" read(*,*) t
if(t==1)then 运行结果：
do i=1,9
do j=i+1,10
if(a(j)>a(i)) then
t=a(i)
a(i)=a(j)
a(j)=t
end if
end do
end do
else
do i=1,9
do j=i+1,10
if(a(j)
t=a(i)
a(i)=a(j)
a(j)=t
end if
end do
end do
end if
write(*,*)"排序后的数组为："
write(*,"(i5)\") (a(i),i=1,10)
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 函数 实验日期 2012-4-27
一、 实验目的：练习两种函数定义和使用语句
二、 实验要求：阅读例题并调试运行
三、 实验结果及分析（1）program e81
implicit none
real a
real b
real add
read(*,*)a,b
write(*,*) add(a,b)
stop
end 运行结果：
function add(a,b)
implicit none
real a,b,add
add=a+b
return
end
（2）program ex0805
implicit none
integer :: a = 1
integer :: b = 2
write(*,*) a,b
call add(a)
call add(b)
write(*,*) a,b
stop
end 运行结果：
subroutine add(num)
implicit none
integer :: num
num = num+1
return
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 函数 实验日期 2012-5-4
一、 实验目的：练习两种函数定义和使用语句
二、 实验要求：完成第八章课后习题
三、 实验结果及分析
（1）program e0801 运行结果：
implicit none
real r,s
write(*,*)"请输入半径："
read(*,*) r
call mj(r,s)
write(*,*)"圆的面积是：",s
stop
end program e0801
subroutine mj(r,s)
implicit none
real r,s
s=3.14*r*r
return
end subroutine mj
（2）program e0802 运行结果：
implicit none
real r,s
real,external :: mj
write(*,*) "请输入半径："
read(*,*) r
s=mj(r)
write(*,*) "圆的面积是：",s
stop
end
function mj(r)
implicit none
real mj,r
mj=3.14*r*r
return
end function mj
（3）program e0803 运行结果：
implicit none
integer i
write(*,*)"请输入参数"
read(*,*)i
call xh(i)
stop
end program e0803
subroutine xh(i)
implicit none
100 format(a1,\)
integer i,j
do j=1,i
write(*,100)"*"
if(j==i) then
write(*,'(/)')
end if
end do
end subroutine xh
（4）program e0804
implicit none
integer,external :: dg
integer n,s
read(*,*)n
s=dg(n)
write(*,*)s
stop
end
recursive function dg(n)
implicit none
integer dg,n
dg=n
if(n>=2) then
dg=dg+dg(n-1)
else
return
end if 运行结果：
end
（5）program e0805 运行结果：
implicit none
integer m,n,t
integer,external :: gys
write(*,*)"请输入m和n："
read(*,"(1i,1i)")m,n
t=gys(m,n)
write(*,*)"最大公约数是：",t
stop
end
function gys(m,n,t)
implicit none
integer m,n,gys,r,t
if(n
t=n
n=m
m=t
end If
r=mod(m,n)
do While(r/=0)
m=n
n=r
r=mod(m,n)
end do
gys=n
return
end function gys
河北大学工商学院Fortran程序设计实验报告
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 综合练习 实验日期 2012-5-11
一、 实验目的：通过计算内力的小型程序练习之前的学习内容
二、 实验要求：完成调试并运行程序
三、 实验结果及分析
program neili
implicit none
integer xz,i,j,k,n ! 定义变量
character sc,jc
real f(0:15),x(0:15),l,fa,fb,fs,wz,m,fp
i=0
write(*,*)"请输入F的个数："
read(*,*) n
do i=1,n,1
write(*,*)"请输入F的值："
read(*,*) f(i)
write(*,*)"请输入F的作用位置："
read(*,*) x(i)
end do
write(*,*)"请输入杆的长度："
read(*,*) l
write(*,*)"请输入所要查询的位置："
read(*,*) wz
write(*,*)"请检查数据：" !输出检查数据
do j=1,n,1
write(*,100) j,f(j),x(j)
end do
100 format('F',i1,'=',f5.2,';','作用位置：',f5.2)
write(*,200) l
200 format("梁的总长为：",f5.2)
write(*,*)"是否正确？（Y or N）" !判断是否正确
read(*,*) jc
if(jc=="Y".or.jc=="y") then
do j=1,n,1 !计算过程 fb=fb+f(j)*x(j)
end do
fb=fb/l do j=1,n,1
fa=fa+f(j)
end do
fa=fa-fb
do j=1,i,1
if(wzx(j-1)) then
do k=0,j-1,1
fs=fa-f(k)
end do
end if
end do
fp=fa
m=0
do j=1,n,1
if(wzx(j-1)) then
k=j
end if
end do
if(k==1)then
m=fa*wz
else
do j=1,k-1,1
m=m+fp*(x(j)-x(j-1))
fp=fp-f(j)
end do
m=m+fp*(wz-x(j))
end if
write(*,300) wz,fs,m !输出结果
300 format(f5.2,"位置的剪力为：",f5.2,"弯矩为：",f5.2) end if
stop
end
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 文件操作 实验日期 2012-5-18
一、 实验目的：练习fortran的文件操作
二、 实验要求：编制小程序，练习文件读写操作
三、 实验结果及分析
program e0901
implicit none
integer a,b,c,d,i
open(1,file="E:\输入.txt")
read(1,*) a,b,c,d
open(2,file="E:\输出.txt")
write(2,100) d,c,b,a
write(*,*) "成功！！！"
100 format(i1,i1,i1,i1)
stop
end
运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 文件操作 实验日期 2012-5-25
一、 实验目的：练习文件操作语句
二、 实验要求：改写上一个内力程序，添加文件操作
三、 实验结果及分析
program neili
implicit none
integer xz,i,j,k,n ! 定义变量 character sc,jc
real f(0:15),x(0:15),l,fa,fb,fs,fp,wz,m
i=0
write(*,*) "请选择数据的输入方式：（1：手动输入；2：文件输入）" !选择输入方式
read(*,*) xz
if(xz==1) then ! 手动输入
write(*,*)"请输入F的个数："
read(*,*) n
do i=1,n,1
write(*,*)"请输入F的值："
read(*,*) f(i)
write(*,*)"请输入F的作用位置："
read(*,*) x(i)
end do
write(*,*)"请输入杆的长度："
read(*,*) l
write(*,*)"请输入所要查询的位置："
read(*,*) wz
else if(xz==2) then ! 文件输入，文件保存在E:\输入.txt write(*,*)"请输入F的个数："
open(1,file="E:\输入.txt")
read(*,*) n
do i=1,n,1
read(1,*)f(i),x(i)
end do
read(1,*)l
write(*,*)"请输入所要查询的位置："
read(*,*) wz
end if
write(*,*)"请检查数据：" !输出检查数据
do j=1,n,1
write(*,100) j,f(j),x(j)
end do
100 format('F',i1,'=',f5.2,';','作用位置：',f5.2)
write(*,200) l
200 format("梁的总长为：",f5.2)
write(*,*)"是否正确？（Y or N）"
read(*,*) jc
if(jc=="Y".or.jc=="y") then
do j=1,n,1
fb=fb+f(j)*x(j)
end do
fb=fb/l
do j=1,n,1
fa=fa+f(j)
end do
fa=fa-fb
fs=fa
do j=1,i,1
if(wzx(j-1)) then
do k=1,j-1,1
fs=fs-f(k)
end do
end if
end do
fp=fa
m=0
do j=1,n,1
if(wzx(j-1)) then
k=j
end if
end do
if(k==1)then
m=fa*wz
else
do j=1,k-1,1
m=m+fp*(x(j)-x(j-1))
fp=fp-f(j) !判断是否正确计算过程 !
end do
m=m+fp*(wz-x(j))
end if
write(*,300) wz,fs,m !输出结果 300 format(f5.2,"位置的剪力为：",f5.2,"弯矩为：",f5.2)
write(*,*)"是否把计算结果输出到文件？（Y or N）:"
read(*,*) sc
if(sc=="y".or."Y") then
open(unit=2,file="E:\输出.txt")
do j=1,n,1
write(2,100) j,f(j),x(j)
end do
write(2,200) l
write(2,300) wz,fs,m
write(*,*)"文件已保存到“E:\输出.txt”"
end if
end if
stop
end 运行结果：
输入文件内容：
输出文件：
河北大学工商学院Fortran程序设计实验报告
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 综合练习 实验日期 2012-6-1
一、 实验目的：综合练习学习的内容，练习编制较复杂的程序
二、 实验要求：编写一个高斯消元解多元方程组的程序
三、 实验结果及分析
program fangchengzu
implicit none
integer n,i,j,k,z
character jc,wj
real er(0:15,0:15),yi(0:15),x(0:15),b,lj,er1(0:15,0:15),yi1(0:15)
integer,external :: da
lj=0
write(*,*) "请选择数据的输入方式：（1：手动输入；2：文件输入）" !选择输入方式 read(*,*) i
if(i==1) then
write(*,*)"请输入未知量的个数："
read(*,*) n
100 format("请输入第",i2,"个方程组的自由项")
200 format("请输入第",i2,"个方程组的第",i2,"个系数")
do i=1,n,i
write(*,100) i
read(*,*) yi(i) 输入文件内容： end do
do i=1,n,1
do j=1,n,1
write(*,200) i,j
end do
end do
else
open(1,file="E:\输入.txt")
write(*,*)"请输入未知量的个数："
read(*,*) n
do i=1,n,1
read(1,*)er(i,j)
end do
read(1,*)yi(i)
end do
end if
write(*,*)"请确认方程组是否正确："
300 format(f7.4,"x",i1,\)
400 format("=",f7.4)
do i=1,n,1
do j=1,n,1
write(*,300) er(i,j),j
if(j
write(*,"(1a,\)")"+"
end if
end do
write(*,400) yi(i)
end do
write(*,*)"是否正确？？？（Y/N）"
read(*,*) jc
if(jc=='Y'.or.jc=='y') then
er1=er
yi1=yi
do k=1,n-1,1
z=da(k,n,er)
call huan(z,k,n,yi,er)
do i=k+1,n,1
b=er(i,k)/er(k,k)
do j=1,n,1
er(i,j)=er(i,j)-b*er(k,j)
end do
yi(i)=yi(i)-b*yi(k)
end do
x(n)=yi(n)/er(n,n)
do i=n-1,1,-1
do j=n,i+1,-1
lj=lj+er(i,j)*x(j)
end do
x(i)=(yi(i)-lj)/er(i,i)
lj=0
end do
end do
write(*,*)"方程组的解为："
500 format('x',i1,'=',f9.6)
write(*,500) i,x(i)
end do
write(*,*)"是否把计算结果输出到文件？？？（Y/N）"
read(*,*) wj
if(wj=='y'.or.'Y')then
open(2,file="E:\输出.txt")
write(2,*)"原方程组为："
do i=1,n,1
do j=1,n,1
write(2,300) er1(i,j),j
if(j
write(2,"(1a,\)")"+"
end if
end do
write(2,400) yi1(i)
end do
write(2,*)"方程组的解为："
do i=1,n,1
write(2,500) i,x(i)
end do
write(*,*)"文件已保存到“E:\输出.txt”！"
end if
end if
stop
end
!函数部分
function da(j,n,er) !选取列主元函数
implicit none
integer i,x,j,n,da
real er(15,15),max
max=er(j,j)
do i=j,n,1
if(er(i,j)>max) then
max=er(i,j)
end if
end do
do i=j,n,1
if(er(i,j)==max) then
x=i
end if
end do
da=x
return
end
subroutine huan(x,y,n,yi,er) ！行变换函数
implicit none
integer i,x,y,n
real yi(0:15),er(0:15,0:15),zhong
do i=1,n,1
zhong=er(x,i)
er(x,i)=er(y,i)
er(y,i)=zhong
end do
zhong=yi(x)
yi(x)=yi(y)
yi(y)=zhong
end
运行结果：
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师
实验项目 练习Visual Fortran的使用 实验日期 2012-6-8
一、 实验目的：综合练习
二、 实验要求：练习使用VB调用Fortran
三、 实验结果及分析
Fortran部分：
subroutine fengya(v,h,b,f,p,jd)
!DEC$ ATTRIBUTES DLLEXPORT :: FENGYA
!DEC$ ATTRIBUTES ALIAS : "fengya" :: FENGYA
implicit none
real v,h,b,f,s,p
real jd
s=h*b
f=v*v*cos(jd)*s*1.205/1000
p=f/s
return
stop
end
VB部分：
Private Declare Sub fengya Lib "E:\fengya\Debug\fengya.dll" (v As Single, h As Single, b As Single, f As Single, p As Single, jd As Single)
Private Sub Command1_Click()
Dim p As Single
Dim f As Single
v = Val(Text4.Text)
jd = Val(Text3.Text)
h = Val(Text2.Text)
b = Val(Text1.Text)
Call fengya(v, h, b, f, p, jd)
Text5.Text = f
Text6.Text = p * 1000
End Sub
年级 2010级 学号 姓名 成绩
专业 土木工程 实验地点 B3-216 指导教师 实验项目 综合练习 实验日期 2012-6-15
一、 实验目的：练习使用VB调用fortran程序
二、 实验要求：改写计算简支梁内力程序，通过VB建立友好的使
用界面
三、 实验结果及分析
Fortran部分：
subroutine neili(f,x,m,n,wz,l,fs)
!DEC$ ATTRIBUTES DLLEXPORT :: NEILI
!DEC$ ATTRIBUTES ALIAS : "neili" :: NEILI
implicit none
integer i,j,k,n ! 定义变量
real f(0:15),x(0:15),l,fa,fb,fs,fp,wz,m
i=0
do j=1,n,1 !计算过程
fb=fb+f(j)*x(j)
end do
fb=fb/l
do j=1,n,1
fa=fa+f(j) DLL文件：
end do
fa=fa-fb
fs=fa
do j=1,n,1
if(wzx(j-1)) then
do k=1,j-1,1
fs=fs-f(k)
end do
end if
end do
fp=fa
m=0
do j=1,n,1
if(wzx(j-1)) then
k=j
end if
end do
if(k==1)then
m=fa*wz
else
do j=1,k-1,1
m=m+fp*(x(j)-x(j-1))
fp=fp-f(j)
end do
m=m+fp*(wz-x(j))
end if
return
end
VB部分：
Private Declare Sub neili Lib "E:\neili\neili\Debug\neili.dll" (f As Single, x As Single, m As Single, n As Integer, wz As Single, l As Single, fs As Single)
Private Sub Command1_Click()
Dim x(0 To 15) As Single
Dim f(0 To 15) As Single
Dim l As Single
Dim wz As Single
Dim n As Integer
Dim fs As Single
Dim m As Single
Dim r As String
l = Val(Text1.Text)
wz = Val(Text2.Text)
x(0) = 0
f(0) = 0
If Option1.Value = True Then
n = InputBox("请输入外力的数量")
For i = 1 To n
f(i) = InputBox("请输入第" & i & "个外力的大小")
x(i) = InputBox("请输入第" & i & "个外力的作用点")
Next i
Else
n = InputBox("请输入外力的数量")
CommonDialog1.Filter = "文本文件(*.txt)|*.txt"
CommonDialog1.ShowOpen
r = CommonDialog1.FileName
Open r For Input As #1
For i = 1 To n
Input #1, f(i), x(i)
Next i
Close #1
End If
Call neili(f(0), x(0), m, n, wz, l, fs)
Label3.Caption = "剪力：" & fs & "，弯矩：" & m End Sub
输入文件不变，运行结果：