fortran习题课
Fortran练习经典题目
Fortran练习经典题目a, 输入一个年、月、日并计算它是本年度的第几天。
b.输入任意一年份，给出该年出生人的属相，如1945年出生的人的属相为“鸡”。
c.显示输出2000~2099年的任何一年的某一月的月历，所要显示的年月有键盘输入。
如2002年5月的月历形式如下；5月2002年日一二三四五六1 2 3 4 5 6 78 9 10 11 12 13 1415 16 17 18 19 20 2122 23 24 25 26 27 2829 30 31d.显示输出2000~2099年的任何一年的年历，并写入一文本文件中。
e.以上功能都应从菜单中选择执行。
提示：a中若y为年份，d是该年的某月某日从1月1日开始经过的天数，则s=（y-1）*1.2425+d。
若s除以7后所得的余数取整后为0，则为周日，为1则周一。
program firstquestionimplicit noneinteger::q,i,ldayinteger::year,month,day,days,mday,dscharacter(len=2),dimension(1:37)::tem! 这个程序可以同时在屏幕和文本中输出计算结果。
为了计算不同的问题，引入变量q，当q＝1时，计算某年月日是此年的第几天;! 当q＝2时，计算某年的属相;当q＝3时，计算月历;当q＝4时，计算年历;当q＝0时，退出此程序。
此外，此程序还设置了对输入! 年、月、日的判断，判断其是否合法。
print *,'when q=1,this program can resolve the question thatwhich day some day is in some year! this is the question one.' print *,'when q=2,this program can obtain the shengxiao of some year! this is the question two.'print *,'when q=3,this program can obtain the calendar of some month of some year(2000-2099)! this is the question three.' print *,'when q=4,this program can obtain the Almanac of some year(2000-2099)! this is the question four.'print *,'If you want to exit from this program,please input q=0.'doprint *,'input the number of q:'read *,qif(q==0) exitif (q==1) then2000 print *,'input the year, the month and the day:'read *,year,month,dayif (month>12.or.month<0) print *,'you input wrong month.' if (month>12.or.month<0) goto 2000call leapday(year,month,day,lday)if (lday==0) print *,'you input wrong day.'if (lday==0) goto 2000call numday(year,month,day,days)print '(a14,i3,a18)','The day is the',days,' day of this year.'open(25,file='days.dat',status='unknown')write(25,'(a14,i3,a18)') 'The day is the',days,' day of this year.' close(25)else if (q==2) thenprint *,'input the year:'read *,yearcall shengxiao(year)else if (q==3) then2001 print *,'input the year(2000-2099) and the month:'read *,year,monthif (year>2099.or.year<2000) print *,'you input wrong year,please input the year between 2000 and 2099.'if (year>2099.or.year<2000) goto 2001if (month>12.or.month<0) print *,'you input wrong month.' if (month>12.or.month<0) goto 2001open(27,file='yueli.dat',status='unknown')call nyli(year,month,mday,ds,tem)write(27, "(26x,i2,'月',3x,i4,'年')")month,yearwrite(27, '(18x,7a4)')'日','一','二','三','四','五','六'write(27, '(18x,7a4)')(tem(i),i=1,mday+ds)write(27,*)close(27)else if (q==4) then2002 print *,'input the year(2000-2099):'read *,yearif (year>2099.or.year<2000) print *,'you input wrong year,pleade input the year between 2000 and 2099.' if (year>2099.or.year<2000) goto 2002open(28,file='nianli.dat',status='unknown')do month=1,12call nyli(year,month,mday,ds,tem)write(28, "(26x,i2,'月',3x,i4,'年')")month,yearwrite(28, '(18x,7a4)')'日','一','二','三','四','五','六'write(28, '(18x,7a4)')(tem(i),i=1,mday+ds)write(28,*)end doclose(28)elseprint *,'you input the wrong number of q.' end ifend doend program firstquestionsubroutine shengxiao(year)implicit noneinteger::year,m,nm=year-1945if (m>=12.or.m<=-12) thenn=mod(m,12)elsen=mend ifopen(26,file='shengxiao.dat',status='unknown') if (n==0) thenprint *,'The shengxiao of this year is:鸡'write(26,*)'The shengxiao of this year is:鸡' else if(n==1.or.n==-11) thenprint *,'The shengxiao of this year is:狗'write(26,*)'The shengxiao of this year is:狗' else if(n==2.or.n==-10) thenprint *,'The shengxiao of this year is:猪'write(26,*)'The shengxiao of this year is:猪' else if(n==3.or.n==-9) thenprint *,'The shengxiao of this year is:鼠'write(26,*)'The shengxiao of this year is:鼠' else if(n==4.or.n==-8) thenprint *,'The shengxiao of this year is:牛'write(26,*)'The shengxiao of this year is:牛'else if(n==5.or.n==-7) thenprint *,'The shengxiao of this year is:虎'write(26,*)'The shengxiao of this year is:虎' else if(n==6.or.n==-6) thenprint *,'The shengxiao of this year is:兔'write(26,*)'The shengxiao of this year is:兔' else if(n==7.or.n==-5) thenprint *,'The shengxiao of this year is:尨'write(26,*)'The shengxiao of this year is:尨' else if(n==8.or.n==-4) thenprint *,'The shengxiao of this year is:蛇'write(26,*)'The shengxiao of this year is:蛇' else if(n==9.or.n==-3) thenprint *,'The shengxiao of this year is:马'write(26,*)'The shengxiao of this year is:马' else if(n==10.or.n==-2) thenprint *,'The shengxiao of this year is:羊'write(26,*)'The shengxiao of this year is:羊' else if(n==11.or.n==-1) thenprint *,'The shengxiao of this year is:猴'write(26,*)'The shengxiao of this year is:猴' end ifclose(26)end subroutine shengxiaosubroutine nyli(year,month,mday,ds,tem) implicit noneinteger::year,month,days,mday integer::i,m,ds,dts,qreal::scharacter(len=2),dimension(1:37)::temcall numday(year,month,1,days)call monday(year,month,mday)s=(year-1)*1.2425+daysds=int(s-int(s/7)*7)do i=1,37tem(ds+1)='1';tem(ds+11)='11';tem(ds+12)='12';tem(ds+2)='2';tem(ds+13)='13';tem(ds+14)='14';tem(ds+3)='3';tem(ds+15)='15';tem(ds+16)='16';tem(ds+4)='4';tem(ds+17)='17';tem(ds+18)='18';tem(ds+5)='5';tem(ds+19)='19';tem(ds+20)='20';tem(ds+6)='6';tem(ds+21)='21';tem(ds+22)='22';tem(ds+7)='7';tem(ds+23)='23';tem(ds+24)='24';tem(ds+8)='8';tem(ds+25)='25';tem(ds+26)='26';tem(ds+9)='9';tem(ds+27)='27';tem(ds+28)='28';tem(ds+10)='10';tem(ds+29)='29';tem(ds+30)='30';tem(ds+ 31)='31'; print "(26x,i2,'月',3x,i4,'年')",month,yearprint '(18x,7a4)','日','一','二','三','四','五','六'print '(18x,7a4)',(tem(i),i=1,mday+ds)print *end subroutine nylisubroutine numday(year,month,day,days)implicit noneinteger::year,month,day,days,nlogical::leapcall leapyear(year,leap)n=int(month/2)if (month<=8) thenif (mod(month,2)/=0) thendays=30*n+31*n+dayelsedays=30*(n-1)+31*n+dayend ifelseif (mod(month,2)/=0) thendays=30*(n-1)+31*(n+1)+dayelsedays=30*(n-1)+31*n+dayif(month>2) thenif (leap) thendays=days-1elsedays=days-2end ifend ifend subroutine numdaysubroutine monday(year,month,mday) implicit none integer::year,month,mday logical::leapcall leapyear(year,leap)select case (month)case (4,6,9,11)mday=30case (1,3,5,7,8,10,12)mday=31case (2)for_feb:select case (leap)case (.true.)mday=29case (.false.)mday=28end select for_febcase defaultend selectend subroutine monday subroutine leapyear(year,leap)implicit noneinteger::yearlogical::leapif (mod(year,4)/=0) thenleap=.false.else if (mod(year,100)/=0) thenleap=.true.else if (mod(year,400)/=0) thenleap=.true.elseleap=.false.end ifend subroutine leapyearsubroutine leapday(year,month,day,lday) implicit none integer::year,month,day,lday logical::leapcall leapyear(year,leap)select case (month)case (4,6,9,11)if (day>30.or.day<1) thenlday=0elselday=1end ifcase (1,3,5,7,8,10,12)if (day>31.or.day<1) thenlday=0elselday=1end ifcase (2)for_feb:select case (leap)case (.true.)if (day>29.or.day<1) thenlday=0elselday=1end ifcase (.false.)if (day>28.or.day<1) thenlday=0elselday=1end ifend select for_febcase defaultend selectend subroutine leapday素数是只能被1与其本身整除的数，下面给出一种寻找素数的方法：a生存一个数组，将其所有的元素初始化为1b 从数组下标为2的元素开始，每次寻找数值为1 的数组元素。
fortran例题6
工程分析程序设计上机作业（六）上机目的：练习派生类型的定义、构造、初始化，成员的调用和操作，操作符的重载，指针1、构造一个由年、月、日组成的派生类型，并编写程序，实现从键盘上输入年、月、日，由程序计算出是当年度的第几天。
例如：输入：2011, 4, 8输出：4月8日是2011年的第98天。
注意：需考虑闰年的情形。
program maintype day !day 是年、月、日组成的派生类型integer yearinteger monthinteger dateend typetype(day)::dinteger i,j,k,n,m ! n 为天数n=0print*,"please imput the year month date"read*,d%year,d%month,d%date!判断是否为闰年if(mod(d%year,4)==0.and.mod(d%year,100)/=0.or.mod(d%year,400)==0) thendo i=1,d%month-1 !31天的月1 3 5 7 8 10 12，30天4 6 9 11 ，29天2if(i==1.or.i==3.or.i==5.or.i==7.or.i==8.or.i==10.or.i==12) thenn=n+31else if(i==2) thenn=n+29elsen=n+30end ifend doelse !不是闰年do i=1,d%month-1 !31天的月1 3 5 7 8 10 12，30天4 6 9 11 ，28天2if(i==1.or.i==3.or.i==5.or.i==7.or.i==8.or.i==10.or.i==12) thenn=n+31else if(i==2) thenn=n+28elsen=n+30end ifend doend ifn=n+d%datewrite(*,"(I5,'年',I3,'月',I3,'日是第',I3,'天')",advance='no') d%year,d%month,d%date,nend2、设计一个“-”操作符的重载，把集合A中那些同时又出现在集合B中的元素去掉。
fortran课本习题答案
fortran课本习题答案
Fortran课本习题答案
在学习Fortran编程语言的过程中，课本习题答案是非常重要的。
它们不仅可以帮助我们更好地理解和掌握知识，还可以帮助我们提高编程能力和解决问题的
能力。
首先，课本习题答案可以帮助我们检验自己的学习成果。
通过完成课本习题并
对比答案，我们可以了解自己在学习中的掌握程度，发现自己的不足之处，从
而有针对性地进行学习和提高。
其次，课本习题答案还可以帮助我们更好地理解知识点。
在完成习题的过程中，我们可能会遇到一些困难和疑惑，而课本习题答案可以为我们提供参考和解答，帮助我们更好地理解和掌握知识点。
此外，课本习题答案还可以帮助我们提高编程能力。
通过不断地完成习题并对
比答案，我们可以积累更多的编程经验，提高自己的编程能力，同时也可以学
习到一些常见的编程技巧和方法。
总之，课本习题答案对于我们学习Fortran编程语言是非常重要的。
它们不仅可以帮助我们检验学习成果，更可以帮助我们更好地理解知识点，提高编程能力，是我们学习的重要辅助工具。
希望大家能够充分利用课本习题答案，不断提高
自己的编程水平，取得更好的学习成绩。
fortran课后习题第五章
第五章第一题program wd51implicit nonereal :: areal :: bwrite(*,*) "请输入一位上班族的月收入a="read(*,*) aif (a<=1000) thenb=a*0.03else if(a>=1000 .and. a<=5000) thenb=a*0.1elseb=a*0.15end ifwrite(*,*)"这位上班族所应缴纳的税金b=",bstopend第二题program wd52implicit noneinteger :: weekwrite(*,*)"请输入星期来查询当天晚上的节目week=" read(*,*) weekif(week==1 .or. week==4) thenwrite(*,*) "新闻"else if(week==2 .or. week==5) thenwrite(*,*) "电视剧"else if(week==3 .or. week==6) thenwrite(*,*) "卡通片"elsewrite(*,*) "电影"end ifend第三题program wd53implicit noneinteger age,moneyreal taxwrite(*,*) "请输入一位上班族的年龄="read (*,*) agewrite(*,*) "输入他的年收入="read (*,*) moneyif (age<50) thenif(money<=1000) thentax=money*0.03else if(money>1000 .and. money<5000) thentax=money*0.1elsetax=money*0.15end ifelse if (age>=50) thenif(money<=1000) thentax=money*0.05else if(money>1000 .and. money<5000) thentax=money*0.07elsetax=money*0.1end ifend ifwrite(*,*) "这位上班族所缴纳的税金是=",tax stopend第四题program wd54implicit noneinteger year,daylogical :: a,b,cwrite(*,*) "请输入一个公元年份="read (*,*) yeara=(MOD(year,4)==0)b=(MOD(year,100)==0)c=(MOD(year,400)==0)if((a.NEQV.b) .or. c) thenday=366elseday=365end ifwrite(*,*)"一年当中有",day,"天" stopend。
fortran课后习题答案
fortran课后习题答案Fortran课后习题答案Fortran是一种编程语言，广泛应用于科学计算和工程领域。
学习Fortran的过程中，课后习题是非常重要的一部分，通过解答这些习题，可以巩固所学的知识，并且提升自己的编程能力。
在本文中，我将为大家提供一些Fortran课后习题的答案，希望对大家的学习有所帮助。
1. 编写一个Fortran程序，计算并输出1到100之间所有偶数的和。
```fortranprogram sum_even_numbersimplicit noneinteger :: i, sumsum = 0do i = 1, 100if (mod(i, 2) == 0) thensum = sum + iend ifend doprint *, "The sum of even numbers from 1 to 100 is", sumend program sum_even_numbers```2. 编写一个Fortran程序，计算并输出用户输入的两个数的乘积。
```fortranprogram multiply_numbersimplicit nonereal :: num1, num2, productprint *, "Enter the first number:"read *, num1print *, "Enter the second number:"read *, num2product = num1 * num2print *, "The product of", num1, "and", num2, "is", productend program multiply_numbers```3. 编写一个Fortran程序，计算并输出用户输入的一个数的平方根。
fortran课后习题
5.3 program main implicit none integer nian,shouru real suijin read(*,*) nian read(*,*) shouru if (nian<50.and.nian>0) then if (shouru>=1000 .and. shouru<=5000) then suijin=shouru*0.1 end if if (shouru>5000) then suijin=shouru*0.15 end if if (shouru<1000) then suijin=shouru*0.03 end if else if (nian>50) then if (shouru>=1000 .and. shouru<=5000) then suijin=shouru*0.07 end if if (shouru>5000) then suijin=shouru*0.1 end if if (shouru<1000) then suijin=shouru*0.05 end if end if write(*,*)"应缴纳的税金金额为：" write(*,*) suijin end 5.4 program main implicit none integer day write(*,*) "请输入一个公元的年份：" read(*,*) day if (mod(day,4)==0) then
write(*,*)"一年有366天" else if(mod(day,100)==0.and.mod(day,400)==0) then write(*,*)"一年有366天" else write(*,*)"一年有365天" end if End 6.1 method one: program main implicit none integer counter do counter=1,5 write(*,*)"Fortran" end do end method two: program main implicit none integer counter counter=1 do while(counter<=5) write(*,*)"Fortran" counter=counter+1 end do end 6.2 program main implicit none integer counter integer::ans=0 counter=1 do while(counter<100) ans=ans+counter counter=counter+2 end do
Fortran平时编程练习及答案(上)
1：编程找出并输出100—150之间和400—450之间能被9整除的数。
程序：program ex0401implicit noneinteger ido i=100, 150if(mod(i,9).eq.0) thenwrite(*,10) i10 format(i3)end ifend dodo i=400, 450if(mod(i,9).eq.0) thenwrite(*,20) i20 format(i3)end ifend doend运行结果：2：回文数是指正读与反读都一样的数。
如：232，编程求100到999之间的回文数。
程序：program ex0402implicit noneinteger ainteger cinteger ido 10 i=100,999a=i/100 !百位上的数字c=mod(i,10) !个位上的数字if(a.eq.c) thenwrite(*,20) i20 format(i8)endif10 continueEnd运行结果：3：输出所有水仙花数（水仙花数是指一个三位正整数，其各位数字的立方和等于该数本身）编程：program ex0403implicit noneinteger ainteger binteger cinteger iwrite(*,*)'水仙花数：'do 10 i=100,999a=i/100 !百位上的数字b=mod(i,100)/10 !十位上的数字c=mod(i,10) !个位上的数字if(i.eq.a**3+b**3+c**3) thenwrite(*,20)i,a,b,c20 format(5x,i3,'=',i2,'^3+',i2,'^3+',i2,'^3')endif10 continueend运行结果：4：编程输出如下图形** * ** * * * ** * * * * * ** * * * ** * **编程：program ex0404implicit noneinteger i,jcharacter a(7)do i=1,7 !输入数组a(i)='*'end dodo j=1,4 !前四行write(*,'(<3*(4-j)>x,10a3)')(a(i),i=1,2*j-1)end dodo j=3,1,-1 !后三行write(*,'(<3*(4-j)>x,10a3)')(a(i),i=1,2*j-1)end doend运行结果：5：输入n个数，找出所有大于n个数的平均值的那些数及最小数。
Fortran95第一章第六大题习题与答案
1. 从键盘输入a,b,c 的值，计算f=cos ｜a+b ｜/sin ｜b｜｜a｜++tan c 上机执行该程序，输入a=-4.6°,b=10°,c=21.85°,观察计算结果。
Program ex1_1implicit nonereal a,b,c,fprint*,'请输入a,b,c(角度值)'read*,a,b,ca=a*3.14159/180.0b=b*3.14159/180.0c=c*3.14159/180.0f=cos(abs(a+b))/sin(sqrt(abs(a)+abs(b)))+tan(c)write(*,*)'f=',fstopEnd2.设圆锥体底面半径r 为6，高h 为5，从键盘输入r 、h ，计算圆锥体体积。
计算公式为V=32h r π。
Program ex1_2implicit nonereal r,h,vprint*,'请输入r,h 的值'read*,r,hv=3.14159*r*r*h/3write(*,*)'v=',vstopEnd3.求一元二次方程02=++c bx ax 的两个根1x 和2x 。
方程的系数a 、b 、c 值从键盘输入并假定042>-ac b 。
Program ex1_3implicit nonereal a,b,c,x1,x2print*,'请输入a,b,c 的值'read*,a,b,cx1=(b+sqrt(b*b-4*a*c))/2*ax2=(b-sqrt(b*b-4*a*c))/2*awrite(*,*)'x1=',x1,'x2=',x2stopEnd4.从键盘输入一个三位十进制整数，分别输出其个位、十位、百位上的数字。
Program ex1_4implicit noneinteger xprint*,'请输入一个三位十进制整数'read*,xwrite(*,*)'个位数=',mod(x,10)write(*,*)'十位数=',mod(x/10,10)write(*,*)'百位数=',x/100stopEnd5.已知ysin(⋅)+=+，分别计算等号两边的算式并输出计算⋅sinyxcosxycosx sin结果（x=30°,y=45°从键盘输入）。
Fortran95第二章第五大题习题与答案
Fortran95第二章第五大题习题与答案1. 计算以下分段函数的值。
≤≤-<≤-+-=)0(s i n)2()0(s i n )2(ππππx x x x x x y Program ex2_1implicit nonereal x,yreal,parameter::pi=3.14159real,parameter::npi=-3.14159print*,'请输入x 的值'read*,xif(x>=npi.and.x<0)theny=-(2.0*pi+x)*sin(x)write(*,*)'y=',yelseif(x>=0.and.x<=pi)theny=(2.0*pi-x)*sin(x)write(*,*)'y=',yelsewrite(*,*)'x 值超出定义域范围'endifstopEnd2. 输入一个数M ，判断它是否能被3或5整除，如能被其中一个数整除，则输出M ，否则输出“此数不能被3或5整除”的提示信息。
Program ex2_2implicit noneinteger mprint*,'请输入一个整数的值'read*,mif(mod(m,3)==0.or.mod(m,5)==0)thenwrite(*,*)'m=',melsewrite(*,*)'输入的整数不能被3或5整除!'endifstopEnd3. 某电视台晚上8点的节目安排如下：星期一、星期四播出新闻；星期二、星期五播出电视剧；星期三、星期六播出儿童节目；星期日播出电影。
写出程序，根据输入星期几来查询当天晚上的节目。
Program ex2_3implicit noneinteger mprint*,'请输入星期序号(星期一~日依次为1~7)'read*,mif(m==1.or.m==4)thenwrite(*,*)'新闻'elseif(m==2.or.m==5)thenwrite(*,*)'电视剧'elseif(m==3.or.m==6)thenwrite(*,*)'儿童节目'elseif(m==7)thenwrite(*,*)'电影'elsewrite(*,*)'输入序号不正确!'endifstopEnd4.输入一个学生的学号和三门课程的成绩。
FORTRAN习题答案
FORTRAN习题答案习题二一、问答题1. 给出下面变量名称,哪些是合法变量？哪些是非法变量？说明原因。
Count 、num_2、x&y 、4x+5y 、china-suzhou 、$us 、AbCdE 、Mr.bai 、t5、_another 、school_class_25、#125、2002Y 、π、β、A01/02、alpha 、date(1) 1. 判定下面整数,指出哪些是合法整数,哪些是非法整数？说明原因。
-0、+ 215、$125、3,245,895、5.3245、5#384、-524_3、#5DFE 、23-345、16#1A2B 、38#ABCD 、8#275_2、+327890、4 #3212. 判定下面实数,指出哪些是合法实数,哪些是非法实数？说明原因。
-0E2、45.2345E3.5、-5489E25_8、-.2345E-35、$185.45E 、+ 2.753425E24_3、58D85、+0.E-0、-00000.001E5、5,443,223.44、-12 34E+2、+ 18.5E 18、2.5E42习题三一、选择题1．下面是V isual Fortran 中正确的表达式是。
（A ）A*COS(X)+∣B ∣ （B ）2*EXP(2*X)/SQRT(16.0)（C ）B 2-4AC （D ）MOD （24.5,0.5）2．下面算术赋值语句中正确的语句是。
（A ）M*N=(X-Y)/Z （B ）+R=A+B/C（C ）X=Y=Z-1.0 （D ）Y=A*B/C/D3．算术表达式1/3+2/3的值为。
（A ）0 （B ） 1 （C ） 0.99999999 （D ）值不确定二、问答题1. 将下列代数式用Visual Fortran 表达式描述：① ②③ 4sin 3A-3sinA+sin3A ④ 2．执行下列赋值语句后，变量中的值。
变量的类型遵循I —N 规则。
北京邮电大学出版社FORTRAN程序设计课后习题答案2
北京邮电大学出版社FORTRAN程序设计课后习题答案2北京邮电大学出版社FORTRAN程序设计课后习题答案2 PROGRAM EX3_4CHARACTER*1 LETTER!方法一print*,' 请输入一个英文字母：'READ*,LETTERif(LETTER>='A' .and. LETTER<='Z') THENwrite(*,*)' 你输入的',LETTER,'为大写字母。
'elseif(LETTER>='a' .and. LETTER<='z')THENwrite(*,*)' 你输入的',LETTER,'为小写字母。
'elsewrite(*,*)' 你输入的',LETTER,'不是字母。
'endif!方法二print*,' 请输入一个英文字母：'READ*,LETTERSELECT CASE(LETTER)CASE('A':'Z')write(*,*)' 你输入的',LETTER,'为大写字母。
'CASE('a':'z')write(*,*)' 你输入的',LETTER,'为小写字母。
'CASE DEFAULTwrite(*,*)' 你输入的',LETTER,'不是字母。
'ENDSELECT!方法三print*,' 请输入一个英文字母：'READ*,LETTERI=ICHAR(LETTER) !转化字符LETTER为对应的ASCII值if(i>=65 .and. i<=90) write(*,*)' 你输入的',LETTER,'为大写字母。
Fortran程序设计课后习题答案方便
第四章1.program main implicit none write(*,*) "Have a good time." write(*,*) "That's not bad." write(*,*) '"Mary" isn''t my name.' end program2.program main real, parameter :: PI=3 implicit none.14159 real radius write(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积='f8. 3)") radius*radius*PI end program3.program main implicit none real grades write(*,*) "请输入成绩" read(*,*) grades write(*,"(' 调整后成绩为 'f8.3)") SQRT(grades)*10.0 end program4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a ! 输出1, 因为使用整数计算, 小数部分会无条件舍去 write(*,*) rb/ra ! 输出1.55.p rogram main implicit none type distance real meter, inch, cm end type type(distance) :: d write(*,*) "请输入长度:" read(*,*) d%meter d%cm =d%meter*100 d%inch = d%cm/2.54 write(*,"(f8.3'米 ='f8.3'厘米 ='f8.3'英寸')")d%meter, d%cm, d%inch end program第五章1.program main implicit none integer money real tax write(*,*) "请输入月收入" read(*,*) money if ( money<1000 ) then tax = 0.03 else if( money<5000) then tax = 0.1 else tax = 0.15 end if write(*,"(' 税金为 'I8)") nint(money*tax) end program2.program main implicit none integer day character(len=20) :: tv write(*,*) "请输入星期几" read(*,*) day select case(day) case(1,4) tv= "新闻" case(2,5) tv = "电视剧" case(3,6) tv = "卡通" case(7) tv = "电影" case default write(*,*) "错误的输入" stop end select write(*,*) tv end program3.program main implicit none integer age, money real tax write(*,*) "请输入年龄" read(*,*) age write(*,*) "请输入月收入" read(*,*) money if( age<50 ) then if ( money<1000 ) then tax = 0.03 else if ( money<5000 )then tax = 0.10 else tax = 0.15 end if else if ( money<1000 ) then tax =0.5 else if ( money<5000 )then tax = 0.7 else tax = 0.10 end if end if write(*,"(' 税金为 'I8)") nint(money*tax) end program4.program main implicit none integer year, days logical mod_4, mod_100,mod_400 write(*,*) "请输入年份" read(*,*) year mod_4 = ( MOD(year,4) ==0 ) mod_100 = ( MOD(year,100) == 0 ) mod_400 = ( MOD(year,400) == 0 ) if( (mod_4 .NEQV. mod_100) .or. mod_400 ) then days = 366 else days = 365end if write(*,"('这一年有'I3'天')") days stop end program第六章1.program main implicit none integer i do i=1,5 write(*,*) "Fortran" end do stop end program2.program main implicit none integer i,sum sum = 0 do i=1,99,2 sum =sum+i end do write(*,*) sum stop end program3.program main implicit none integer, parameter :: answer = 45 integer, parameter :: max = 5 integer weight, i do i=1,max write(*,*) "请输入体重" read(*,*) weight if ( weight==answer ) exit end do if ( i<=max ) thenwrite(*,*) "猜对了" else write(*,*) "猜错了" end if stop end program4.program main implicit none integer, parameter :: max=10 integer i realitem real ans ans = 1.0 item = 1.0 do i=2,max item = item/real(i)ans = ans+item end do write(*,*) ans stop end program5.program main implicit none integer, parameter :: length = 79 character(len=length) :: input, output integer i,j write(*,*) "请输入一个字串" read(*,"(A79)") input j=1 do i=1, len_trim(input) if ( input(i:i)/= ' ' ) then output(j:j)=input(i:i) j=j+1 end if end do write(*,"(A79)") output stop end program第七章1.program main implicit none integer, parameter :: max = 10 integer i integer :: a(max) = (/ (2*i, i=1,10) /) integer :: t ! sum()是fortran库函数write(*,*) real(sum(a))/real(max) stop end program2.integer a(5,5) ! 5*5=25 integer b(2,3,4) ! 2*3*4=24 integer c(3,4,5,6) !3*4*5*6=360 integer d(-5:5) ! 11 integer e(-3:3, -3:3) ! 7*7=493.program main implicit none integer, parameter :: max=10 integer f(max) integer i f(1)=0 f(2)=1 do i=3,max f(i)=f(i-1)+f(i-2) end do write(*,"(10I4)") f stop end program4.program main implicit none integer, parameter :: size=10 integer :: a(size)= (/ 5,3,6,4,8,7,1,9,2,10 /) integer :: i,j integer :: t do i=1, size-1do j=i+1, size if ( a(i) < a(j) ) then ! a(i)跟a(j)交换 t=a(i) a(i)=a(j) a(j)=t end if end do end do write(*,"(10I4)") a stop end5.a(2,2) ! 1+(2-1)+(2-1)*(5) = 7 a(3,3) ! 1+(3-1)+(3-1)*(5) = 13第八章1.program main implicit none real radius, area write(*,*) "请输入半径长"read(*,*) radius call CircleArea(radius, area) write(*,"(' 面积 = 'F8.3)")area stop end program subroutine CircleArea(radius, area) implicit nonereal, parameter :: PI=3.14159 real radius, area area = radius*radius*PIreturn end subroutine2.program main implicit none real radius real, external :: CircleAreawrite(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积= 'F8.3)") CircleArea(radius) stop end program real function CircleArea(radius) implicit none real, parameter :: PI=3.14159 real radius CircleArea =radius*radius*PI return end function3.program main implicit none call bar(3) call bar(10) stop end program subroutine bar(length) implicit none integer, intent(in) :: length integeri character(len=79) :: string string=" " do i=1,length string(i:i)='*'end do write(*,"(A79)") string return end subroutine4.p rogram main implicit none integer, external :: add write(*,*) add(100)end program recursive integer function add(n) result(sum) implicit none integer, intent(in) :: n if ( n<0 ) then sum=0 return else if ( n<=1 )then sum=n return end if sum = n + add(n-1) return end function5.program main implicit none integer, external :: gcd write(*,*) gcd(18,12)end program integer function gcd(A,B) implicit none integerA,B,BIG,SMALL,TEMP BIG=max(A,B) SMALL=min(A,B) do while( SMALL /= 1 ) TEMP=mod(BIG,SMALL) if ( TEMP==0 ) exit BIG=SMALL SMALL=TEMP end dogcd=SMALL return end function 6.program main use TextGraphLib implicit none integer, parameter :: maxx=60, maxy=20 real, parameter :: StartX=0.0,EndX=3.14159*2.0 real, parameter :: xinc = (EndX-StartX)/(maxx-1) real x integer i,px,py call SetScreen(60,20) call SetCurrentChar('*') x=StartXdo px=1,maxx py = (maxy/2)*sin(x)+maxy/2+1 call PutChar(px,py) x=x+xincend docall UpdateScreen() stop end program第九章1.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer count integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old")count = 0 do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status )buffer if ( status/=0 ) exit ! 没有资料就跳出循环 write(*,"(A79)")buffer count = count+1 if ( count==24 ) then pause count = 0 endif end do else write(*,*) TRIM(filename)," doesn't exist." end ifstop end2.p rogram main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer iinteger :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old")do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) bufferif ( status/=0 ) exit ! 没有资料就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-3 ) end do write(*,"(A70)") bufferend do else write(*,*) TRIM(filename)," doesn't exist." end if stop end3.program main implicit none type student integer chinese, english, math, science, social, total end type type(student) :: s, total integer, parameter :: students=20, subjects=5 integer i open(10,file="grades.bin",access="direct",recl=1) write(*,"(7A10)") "座号","中文","英文","数学","自然","社会","总分" total = student(0,0,0,0,0,0) do i=1, students read(10,rec=(i-1)*subjects+1) s%chinese read(10,rec=(i-1)*subjects+2) s%english read(10,rec=(i-1)*subjects+3) s%math read(10,rec=(i-1)*subjects+4) s%science read(10,rec=(i-1)*subjects+5)s%social s%total = s%chinese+s%english+s%math+s%science+s%social total%chinese= total%chinese+s%chinese total%english = total%english+s%english total%math =total%math+s%math total%science = total%science+s%science total%social =total%social+s%social total%total = total%total+s%total write(*,"(7I10)") i,s end do write(*,"(A10,6F10.3)") "平均", & real(total%chinese)/real(students),&real(total%english)/real(students),& real(total%math)/real(students),& real(total%science)/real(students),&real(total%social)/real(students),& real(total%total)/real(students)stop end 4.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer i integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)")filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit ! 没有数据就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-(mod(i-1,3)+1) ) end do write(*,"(A70)") buffer end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end5.module typedef type student integer :: num integer :: Chinese, English, Math, Natural, Social integer :: total integer :: rank end type end module program main use typedef implicit none integer, parameter :: fileid=10 integer, parameter :: students=20 character(len=80) :: tempstr type(student) :: s(students) ! 储存学生成绩 type(student) :: total ! 计算平均分数用integer i, num, error open(fileid,file="grades.txt",status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open grades.txt fail." stop end if read(fileid, "(A80)") tempstr ! 读入第一行文字 total=student(0,0,0,0,0,0,0,0) ! 用循环读入每位学生的成绩do i=1,students read(fileid,*) s(i)%num, s(i)%Chinese,s(i)%English, & s(i)%Math, s(i)%Natural, s(i)%Social ! 计算总分 s(i)%Total = s(i)%Chinese + s(i)%English + & s(i)%Math +s(i)%Natural + s(i)%Social ! 累加上各科的分数, 计算各科平均时使用total%Chinese = total%Chinese + s(i)%Chinese total%English = total%English +s(i)%English total%Math = total%Math + s(i)%Math total%Natural = total%Natural + s(i)%Natural total%Social = total%Social + s(i)%Social total%Total = total%Total + s(i)%Total end do call sort(s,students) ! 重新输出每位学生成绩 write(*,"(8A7)") "座号","中文","英文","数学","自然","社会","总分","名次" do i=1,students write(*,"(8I7)") s(i) end do ! 计算并输出平圴分数write(*,"(A7,6F7.1)") "平均", &real(total%Chinese)/real(students),& real(total%English)/real(students),&real(total%Math) /real(students),& real(total%Natural)/real(students),&real(total%Social) /real(students),& real(total%Total) /real(students) stop end program subroutine sort(s,n) use typedef implicit none integer n type(student) :: s(n), t integer i,j do i=1,n-1 do j=i+1,n if( s(i)%total < s(j)%total ) then t = s(i) s(i)=s(j) s(j) = t end ifend do end do forall(i=1:n) s(i)%rank = i end forall end subroutine第十章1.integer(kind=4) :: a ! 4 bytes real(kind=4) :: b ! 4 bytes real(kind=8) :: c !8 bytes character(len=10) :: str ! 10 bytes integer(kind=4), pointer :: pa !4 bytes real(kind=4), pointer :: pb ! 4 bytes real(kind=8), pointer :: pc !4 bytes character(len=10), pointer :: pstr ! 4 bytes type student integer Chinese, English, Math end type type(student) :: s ! 12 bytes type(student), pointer ::ps ! 4 bytes2.integer, target :: a = 1 integer, target :: b = 2 integer, target :: c = 3 integer, pointer :: p p=>a write(*,*) p ! 1 p=>b write(*,*) p ! 2 p=>c p=5 write(*,*) c !53.module linklist type student integer :: num integer :: Chinese, English,Math, Science, Social end type type datalink type(student) :: item type(datalink), pointer :: next end type contains function SearchList(num, head) implicit none integer :: num type(datalink), pointer :: head, p type(datalink), pointer :: SearchList p=>head nullify(SearchList) do while( associated(p) ) if ( p%item%num==num ) then SearchList => p return end if p=>p%next end do return end function end module linklist programex1016 use linklist implicit none character(len=20) :: filename character(len=80) :: tempstr type(datalink), pointer :: head type(datalink), pointer :: p type(student), allocatable :: s(:) integer i,error,size write(*,*) "filename:" read(*,*) filename open(10, file=filename, status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open file fail!" stop end if allocate(head) nullify(head%next) p=>head size=0 read(10, "(A80)") tempstr ! 读入第一行字符串, 不需要处理它 ! 读入每一位学生的成绩 do while(.true.) read(10,fmt=*, iostat=error) p%item if ( error/=0 )exit size=size+1 allocate(p%next, stat=error) ! 新增下一个数据 if ( error/=0 )then write(*,*) "Out of memory!" stop end if p=>p%next ! 移动到链表的下一个数据 nullify(p%next) end do write(*,"('总共有',I3,'位学生')") size allocate( s(size) ) p=>head do i=1,size s(i)=p%item p=>p%next end do do while(.true.) write(*,*) "要查询几号同学的成绩?" read (*,*) i if( i<1 .or. i>size ) exit ! 输入不合理的座号 write(*,"(5(A6,I3))") "中文",s(i)%Chinese,& "英文",s(i)%English,& "数学",s(i)%Math,& "自然",s(i)%Science,& "社会",s(i)%Social end do write(*,"('座号',I3,'不存在, 程序结束.')") i stopend program4.module typedef implicit none type :: datalink integer :: i type(datalink), pointer :: next end type datalink end module typedef programex1012 use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:' read(*,*) n allocate( head ) head%i=1 nullify(head%next) p=>head do i=2,n allocate( p%next,stat=err ) if ( err /= 0 ) then write(*,*) 'Out of memory!' stop end if p=>p%next p%i=i end do nullify(p%next) p=>head do while(associated(p)) write(*, "(i5)" ) p%i p=>p%next end do ! 释放链表的存储空间p=>head do while(associated(p)) next => p%next deallocate(p) p=>next end do stop end program第十一章1.module utility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r) real, parameter :: PI=3.14159 real r CircleArea =r*r*PI return end function real function RectArea(a,b) real a,b RectArea = a*b return end function end module program main use UTILITY implicit none write(*,*) area(1.0) write(*,*) area(2.0,3.0) stop end program2.module time_utility implicit none type :: time integer :: hour,minute,second end type time interface operator(+) module procedureadd_time_time end interface contains function add_time_time( a, b ) implicit none type(time) :: add_time_time type(time), intent(in) :: a,binteger :: seconds,minutes,carry seconds=a%second+b%second carry=seconds/60 minutes=a%minute+b%minute+carry carry=minutes/60add_time_time%second=mod(seconds,60) add_time_time%minute=mod(minutes,60)add_time_time%hour=a%hour+b%hour+carry return end function add_time_time subroutine input( a ) implicit none type(time), intent(out) :: a write(*,*) " Input hours:" read (*,*) a%hour write(*,*) " Input minutes:"read (*,*) a%minute write(*,*) " Input seconds:" read (*,*) a%second return end subroutine input subroutine output( a ) implicit nonetype(time), intent(in) :: a write(*, "(I3,' hours',I3,' minutes',I3,'seconds')" ) a%hour,a%minute,a%second return end subroutine output endmodule time_utility program main use time_utility implicit nonetype(time) :: a,b,c call input(a) call input(b) c=a+b call output(c)stop end program main3.module rational_utility implicit none private public :: rational, & operator(+), operator(-), operator(*),& operator(/), assignment(=),operator(>),& operator(<), operator(==),operator(/=),& output, input type :: rational integer :: num,denom end type rational interface operator(+) module procedurerat__rat_plus_rat end interface interface operator(-) module procedurerat__rat_minus_rat end interface interface operator(*) module procedurerat__rat_times_rat end interface interface operator(/) module procedurerat__rat_div_rat end interface interface assignment(=) module procedurerat_eq_rat module procedure int_eq_rat module procedure real_eq_rat endinterface interface operator(>) module procedure rat_gt_rat endinterface interface operator(<) module procedure rat_lt_rat endinterface interface operator(==) module procedure rat_compare_rat endinterface interface operator(/=) module procedure rat_ne_rat endinterface contains function rat_gt_rat(a,b) implicit none logical ::rat_gt_rat type(rational), intent(in) :: a,b real :: fa,fbfa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom) if ( fa > fb )then rat_gt_rat=.true. else rat_gt_rat=.false. end if return end function rat_gt_rat function rat_lt_rat(a,b) implicit none logical :: rat_lt_rat type(rational), intent(in) :: a,b real :: fa,fbfa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom) if ( fb > fa )then rat_lt_rat=.true. else rat_lt_rat=.false. end if return end function rat_lt_rat function rat_compare_rat(a,b) implicitnone logical :: rat_compare_rat type(rational), intent(in) :: a,btype(rational) :: c c=a-b if ( c%num == 0 ) thenrat_compare_rat=.true. else rat_compare_rat=.false. end if return end function rat_compare_rat function rat_ne_rat(a,b) implicitnone logical :: rat_ne_rat type(rational), intent(in) :: a,btype(rational) :: c c=a-b if ( c%num==0 ) then rat_ne_rat=.false.else rat_ne_rat=.true. end if return end function rat_ne_rat subroutine rat_eq_rat( rat1, rat2 ) implicit none type(rational),intent(out):: rat1 type(rational), intent(in) :: rat2 rat1%num =rat2%num rat1%denom = rat2%denom return end subroutine rat_eq_ratsubroutine int_eq_rat( int, rat ) implicit none integer, intent(out):: inttype(rational), intent(in) :: rat int = rat%num / rat%denom return end subroutine int_eq_rat subroutine real_eq_rat( float, rat ) implicit none real, intent(out) :: float type(rational), intent(in) :: rat float =real(rat%num) / real(rat%denom) return end subroutine real_eq_rat function reduse( a ) implicit none type(rational), intent(in) :: a integer :: b type(rational) :: reduse b=gcv_interface(a%num,a%denom) reduse%num = a%num/b reduse%denom = a%denom/b return end function reduse function gcv_interface(a,b) implicit none integer, intent(in) ::a,b integer :: gcv_interface if ( min(a,b) .eq. 0 ) then gcv_interface=1 return end if if (a==b) then gcv_interface=a return else if ( a>b ) then gcv_interface=gcv(a,b) else if ( a<b ) then gcv_interface=gcv(b,a) end if return end function gcv_interface recursive function gcv(a,b) result(ans) implicitnone integer, intent(in) :: a,b integer :: m integer :: ans m=mod(a,b) select case(m) case(0) ans=b return case(1) ans=1 return case default ans=gcv(b,m) end select return end function gcv function rat__rat_plus_rat( rat1, rat2 ) implicitnone type(rational) :: rat__rat_plus_rat type(rational), intent(in) ::rat1,rat2 type(rational) :: act act%denom= rat1%denom * rat2%denom act%num = rat1%num*rat2%denom + rat2%num*rat1%denom rat__rat_plus_rat = reduse(act) return end function rat__rat_plus_rat functionrat__rat_minus_rat( rat1, rat2 ) implicit none type(rational) ::rat__rat_minus_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom*rat2%denom temp%num =rat1%num*rat2%denom - rat2%num*rat1%denom rat__rat_minus_rat = reduse( temp ) return end function rat__rat_minus_rat function rat__rat_times_rat( rat1,rat2 ) implicit none type(rational) :: rat__rat_times_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%denom temp%num = rat1%num * rat2%num rat__rat_times_rat = reduse(temp) return end function rat__rat_times_rat function rat__rat_div_rat( rat1, rat2 ) implicit none type(rational) ::rat__rat_div_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%num temp%num =rat1%num * rat2%denom rat__rat_div_rat = reduse(temp) return end function rat__rat_div_rat subroutine input(a) implicit none type(rational), intent(out) :: a write(*,*) "分子:" read(*,*) a%num write(*,*) "分母:" read(*,*) a%denom return end subroutine input subroutine output(a) implicit none type(rational), intent(in) :: a if ( a%denom/=1 ) then write(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom else write(*, "(I3)" ) a%num end if return end subroutine outputend module rational_utility program main use rational_utility implicit none type(rational) :: a,b,c call input(a) call input(b) c=a+b write(*,*)"a+b=" call output(c) c=a-b write(*,*) "a-b=" call output(c) c=a*b write(*,*) "a*b=" call output(c) c=a/b write(*,*) "a/b=" call output(c)if (a>b) write(*,*) "a>b" if (a<b) write(*,*) "a<b" if (a==b) write(*,*) "a==b"if (a/=b) write(*,*) "a/=b" stop end program main4.module vector_utility implicit none type vector real x,y end type interface operator(+) module procedure vector_add_vector end interface interface operator(-) module procedure vector_sub_vector end interface interface operator(*) module procedure real_mul_vector module procedure vector_mul_real module procedure vector_dot_vector end interface interface operator(.dot.) module procedure vector_dot_vector end interface contains type(vector) function vector_add_vector(a,b) type(vector), intent(in) :: a,b vector_add_vector = vector(a%x+b%x, a%y+b%y) end function type(vector) function vector_sub_vector(a,b) type(vector), intent(in) :: a,b vector_sub_vector = vector(a%x-b%x, a%y-b%y) end function type(vector) function real_mul_vector(a,b) real, intent(in) :: a type(vector), intent(in) :: b real_mul_vector = vector( a*b%x, a*b%y ) end functiontype(vector) function vector_mul_real(a,b) type(vector), intent(in) :: a real, intent(in) :: b vector_mul_real = real_mul_vector(b,a) end function real function vector_dot_vector(a,b) type(vector), intent(in) :: a,b vector_dot_vector = a%x*b%x + a%y*b%y end function subroutine output(vec) type(vector) :: vec write(*,"('('F6.2','F6.2')')") vec end subroutine end module program main use vector_utility implicit none type(vector) a,b,ca=vector(1.0, 2.0) b=vector(2.0, 1.0) c=a+b call output(c) c=a-b call output(c) write(*,*) a*b end program main。
fortran习题参考答案
工程分析程序设计上机作业(五)模块化编程上机目的：掌握内部例程、主程序、外部例程、模块等功能的使用方法。
1、有一个六边形，求其面积。
为求面积，作了3条辅助线。
如图所示：(提示，三角形面* a b c积=s(s-a)(s-b)(s-c)，其中s ，a、b、c为三个边长)。
要求用内部函数来计算每个三角形的面积。
program mai nimplicit nonereal :: A(9)=(/10,30,16,13,21,14,20,36,28/)in teger ireal ss=area(A (3) ,A (4) ,A(7))+area(A(2),A(7),A(8))+ &area(A(1),A(8),A(9))+area(A (5),A (6) ,A(9))prin t*,'The area is',scontainsfunction area(x,y,z)implicit nonereal x,y,zreal p,areap=(x+y+z)/2area=sqrt(p*(p-x)*(p-y)*(p-z))end functionend2、编写一个子例程子程序，SUM(S , T , N1 , N2)。
把整型数N1到N2进行求和，并把求和的结果放置到S,把整型数N1到N2进行求积，并把求积的结果放置到T。
并用这个子程序来计算：y =(1 2 3 4) (3 4 5 6 7 8) (3*4*5*6) -(1*2*3)program mai nimplicit nonein teger A(8)in teger i,b,c,d,e,f,g,m, n,yb=O;d=O;g=1; n=1 do i=1,8A(i)=iend docall sum(b,c,1,4) call sum(d,e,3,8) call sum(f,g,3,6) call sum (m,n ,1,3)y=b+d+g-nprin t*,'y=(1+2+3+4)+(3+4+5+6+7+8)+(3*4*5*6)-(1*2*3)=',ycontainssubroutine sum(s,t,N1,N2) in teger s,t,N1,N2,i do i=N1,N2 s=s+A(i) t=t*A(i)end doend subrout ineend3、编写函数子程序GDC求两个数的最大公约数。
Fortran95程序设计课后习题答案(word版方便).docx
第四章1.program main implicit none write(*,*)"Have a good time."write(*,*)"That's not bad."write(*,*) '"Mary" isn''t my name.' end program2.program main real, parameter :: PI=3implicit none.14159real radius write(*,*) "请输入半径长 "read(*,*)radius write(*,"('面积 ='f8.3)")radius*radius*PI end program3.program main implicit none real grades write(*,*)"请输入成绩 "read(*,*)grades write(*,"('调整后成绩为 'f8.3)") SQRT(grades)*10.0 end program4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a! 输出 1,因为使用整数计算,小数部分会无条件舍去write(*,*) rb/ra! 输出 1.55.program main implicit none type distance real meter,inch,cm end type type(distance) ::d write(*,*)" 请输入长度 :"read(*,*)d%meter d%cm = d%meter*100 d%inch=d%cm/2.54write(*,"(f8.3'米 ='f8.3' 厘米 ='f8.3' 英寸 ')") d%meter,d%cm, d%inch end program第五章1.program main implicit none integer money real tax write(*,*) "请输入月收入"read(*,*) money if ( money<1000 ) then tax = 0.03else if ( money<5000) then tax=0.1else tax=0.15end if write(*,"('税金为 'I8)")nint(money*tax)end program2.program main implicit none integer day character(len=20) :: tv write(*,*) "请输入星期几 "read(*,*) day select case(day)case(1,4)tv = " 新闻 "case(2,5)tv = " 电视剧"case(3,6)tv=" 卡通 "case(7)tv = " 电影 "case default write(*,*) "错误的输入 "stop end select write(*,*) tv end program3.program main implicit none integer age, money real tax write(*,*)" 请输入年龄 " read(*,*)age write(*,*)"请输入月收入 "read(*,*)money if (age<50 )then if ( money<1000 ) then tax = 0.03else if ( money<5000 )then tax = 0.10else tax = 0.15end if else if(money<1000) then tax= 0.5else if( money<5000 )then tax = 0.7else tax = 0.10end if end if write(*,"('税金为 'I8)") nint(money*tax) end program4.program main implicit none integer year, days logical mod_4,mod_100, mod_400 write(*,*)" 请输入年份 "read(*,*) year mod_4= ( MOD(year,4)== 0 )mod_100 = ( MOD(year,100) == 0 )mod_400 = (MOD(year,400) ==0)if ((mod_4.NEQV. mod_100) .or. mod_400 ) then days = 366else days = 365end if write(*,"('这一年有 'I3' 天 ')") days stop end program第六章1.program main implicit none integer i do i=1,5write(*,*)"Fortran"end do stop end program2.program main implicit none integer i,sum sum = 0do i=1,99,2sum = sum+i end do write(*,*) sum stop end program3.program main implicit none integer,parameter:: answer= 45integer,parameter :: max = 5integer weight, i do i=1,max write(*,*) "请输入体重 "read(*,*) weight if (weight==answer) exit end do if(i<=max ) then write(*,*)" 猜对了 "else write(*,*) "猜错了 "end if stop end program4.program main implicit none integer, parameter :: max=10integer i real item real ans ans = 1.0item = 1.0do i=2,max item = item/real(i)ans = ans+itemend do write(*,*) ans stop end program5.program main implicit none integer, parameter :: length = 79character(len=length) :: input,output integer i,j write(*,*)"请输入一个字串 "read(*,"(A79)")input j=1 do i=1, len_trim(input)if ( input(i:i) /= ' ' ) then output(j:j)=input(i:i)j=j+1end if end do write(*,"(A79)") output stop end program第七章1.program main implicit none integer,parameter:: max= 10integer i integer:: a(max) =(/ (2*i,i=1,10) /) integer :: t!sum() 是 fortran库函数write(*,*) real(sum(a))/real(max)stop end program2.integer a(5,5)!5*5=25integer b(2,3,4)!2*3*4=24integer c(3,4,5,6) !3*4*5*6=360 integer d( -5:5)! 11 integer e( -3:3, -3:3)! 7*7=493.program main implicit none integer,parameter:: max=10integer f(max)integer i f(1)=0f(2)=1do i=3,max f(i)=f(i -1)+f(i-2)end do write(*,"(10I4)")f stop end program4.program main implicit none integer,parameter::size=10integer:: a(size)=(/ 5,3,6,4,8,7,1,9,2,10/)integer::i,j integer::t do i=1, size-1do j=i+1,size if ( a(i) < a(j) ) then ! a(i)跟 a(j)交换t=a(i)a(i)=a(j)a(j)=t end if end do end do write(*,"(10I4)")a stop end5.a(2,2)!1+(2 -1)+(2-1)*(5)=7a(3,3)! 1+(3-1)+(3-1)*(5) = 13第八章1.program main implicit none real radius,area write(*,*)" 请输入半径长 " read(*,*) radius call CircleArea(radius, area)write(*,"('面积 = 'F8.3)") area stop end program subroutine CircleArea(radius, area)implicit none real, parameter:: PI=3.14159 real radius, area area = radius*radius*PI return end subroutine2.program main implicit none real radius real,external:: CircleArea write(*,*)" 请输入半径长 "read(*,*)radius write(*,"('面积 ='F8.3)")CircleArea(radius)stop end program real function CircleArea(radius)implicit none real,parameter:: PI=3.14159 real radius CircleArea = radius*radius*PI return end function3.program main implicit none call bar(3)call bar(10)stop end program subroutine bar(length)implicit none integer,intent(in)::length integer i character(len=79)::string string=" "do i=1,length string(i:i)='*'end do write(*,"(A79)") string return end subroutine4.program main implicit none integer, external :: add write(*,*) add(100) end program recursive integer function add(n)result(sum)implicit none integer, intent(in):: n if ( n<0 ) then sum=0return else if ( n<=1 ) then sum=n return end if sum = n + add(n-1) return end function5.program main implicit none integer, external :: gcd write(*,*) gcd(18,12) end program integer function gcd(A,B)implicit none integer A,B,BIG,SMALL,TEMP BIG=max(A,B) SMALL=min(A,B)do while(SMALL /= 1 )TEMP=mod(BIG,SMALL)if ( TEMP==0 ) exit BIG=SMALL SMALL=TEMP end do gcd=SMALL return end function6.program main use TextGraphLib implicit none integer,parameter::maxx=60, maxy=20real,parameter:: StartX=0.0,EndX=3.14159*2.0real,parameter::xinc= (EndX-StartX)/(maxx -1)real x integer i,px,py call SetScreen(60,20)call SetCurrentChar('*')x=StartX do px=1,maxx py= (maxy/2)*sin(x)+maxy/2+1callPutChar(px,py)x=x+xinc end docall UpdateScreen()stop end program第九章1.program main implicit none character(len=79)::character(len=79)::buffer integer,parameter:: fileid = 10integer count integer::status=0logical alive write(*,*)":"read(*,"(A79)")inquire(,exist=alive)if(alive)then open(unit=fileid, , &access="sequential", status="old")count = 0do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit!没有资料就跳出循环write(*,"(A79)")buffer count=count+1if( count==24)then pause count=0end if end do else write(*,*)TRIM(),"doesn't exist." end if stop end2.program main implicit none character(len=79)::character(len=79)::buffer integer, parameter :: fileid = 10integer i integer :: status = 0logical alive write(*,*) ":" read(*,"(A79)")inquire(, exist=alive)if (alive )then open(unit=fileid,,& access="sequential",status="old")do while(.true.)read(unit=fileid,fmt="(A79)", iostat=status)buffer if(status/=0)exit!没有资料就跳出循环do i=1, len_trim(buffer)buffer(i:i) = char( ichar(buffer(i:i))-3 )end do write(*,"(A70)") buffer end do else write(*,*) TRIM()," doesn't exist."end if stop end3.program main implicit none type student integer chinese, english,math, science, social,total end type type(student)::s,total integer,parameter:: students=20, subjects=5integer i open(10,file="grades.bin",access="direct",recl=1)write(*,"(7A10)") " 座号 "," 中文 "," 英文 "," 数学 "," 自然 "," 社会 "," 总分 "total=student(0,0,0,0,0,0)do i=1, students read(10,rec=(i -1)*subjects+1)s%chinese read(10,rec=(i -1)*subjects+2) s%english read(10,rec=(i -1)*subjects+3)s%math read(10,rec=(i -1)*subjects+4) s%science read(10,rec=(i -1)*subjects+5)s%social s%total= s%chinese+s%english+s%math+s%science+s%social total%chinese= total%chinese+s%chinese total%english= total%english+s%english total%math= total%math+s%math total%science = total%science+s%science total%social=total%social+s%social total%total= total%total+s%total write(*,"(7I10)") i, s end do write(*,"(A10,6F10.3)") " 平均 ", & real(total%chinese)/real(students),&real(total%english)/real(students),& real(total%math)/real(students),&real(total%science)/real(students),& real(total%social)/real(students),&real(total%total)/real(students)stop end4.program main implicit none character(len=79)::character(len=79)::buffer integer, parameter :: fileid = 10integer i integer :: status = 0logical alive write(*,*) ":"read (*,"(A79)")inquire( , exist=alive)if ( alive ) then open(unit=fileid, , & access="sequential",status="old")do while(.true.)read(unit=fileid,fmt="(A79)", iostat=status)buffer if(status/=0)exit!没有数据就跳出循环do i=1, len_trim(buffer)buffer(i:i)=char(ichar(buffer(i:i)) -(mod(i -1,3)+1))end do write(*,"(A70)")buffer end do else write(*,*)TRIM()," doesn't exist."end if stop end5.module typedef type student integer::num integer::Chinese,English, Math, Natural, Social integer :: total integer :: rank end type end module program main use typedef implicit none integer,parameter::integer,parameter::students=20 character(len=80):: tempstr type(student) :: s(students) !储存学生成绩type(student) :: total!计算平均分数用integer i,num,error open(fileid,file="grades.txt",status="old",iostat=error)if( error/=0)then write(*,*)"Open grades.txt fail."stop end if read(fileid,"(A80)")tempstr! 读入第一行文字total=student(0,0,0,0,0,0,0,0)! 用循环读入每位学生的成绩do i=1,students read(fileid,*) s(i)%num, s(i)%Chinese, s(i)%English, &s(i)%Math, s(i)%Natural, s(i)%Social!计算总分s(i)%Total=s(i)%Chinese +s(i)%English+& s(i)%Math + s(i)%Natural + s(i)%Social!累加上各科的分数,计算各科平均时使用total%Chinese =total%Chinese+s(i)%Chinese total%English=total%English+ s(i)%English total%Math=total%Math+ s(i)%Math total%Natural=total%Natural+ s(i)%Natural total%Social= total%Social + s(i)%Social total%Total= total%Total + s(i)%Total end do call sort(s,students)!重新输出每位学生成绩write(*,"(8A7)") "座号 "," 中文 ","英文 "," 数学 "," 自然 "," 社会 "," 总分 "," 名次 "do i=1,students write(*,"(8I7)")s(i)end do!计算并输出平圴分数write(*,"(A7,6F7.1)")"平均 ",& real(total%Chinese)/real(students),&real(total%English)/real(students),&real(total%Math) /real(students),&real(total%Natural)/real(students),&real(total%Social)/real(students),& real(total%Total)/real(students)stop end program subroutine sort(s,n)use typedef implicit none integer n type(student) :: s(n), t integer i,j do i=1,n -1do j=i+1,n if ( s(i)%total < s(j)%total ) then t = s(i)s(i)=s(j)s(j) = t end if end do end do forall(i=1:n)s(i)%rank = i end forall end subroutine第十章1.integer(kind=4):: a! 4bytes real(kind=4):: b! 4 bytes real(kind=8):: c!8bytes character(len=10):: str!10bytes integer(kind=4),pointer:: pa ! 4 bytes real(kind=4), pointer :: pb! 4 bytes real(kind=8), pointer :: pc! 4 bytes character(len=10), pointer :: pstr ! 4 bytes type student integer Chinese, English, Math end type type(student) :: s! 12 bytes type(student), pointer :: ps ! 4 bytes2.integer, target :: a = 1 integer, target :: b = 2 integer, target :: c = 3 integer, pointer :: p p=>awrite(*,*) p! 1 p=>b write(*,*) p! 2 p=>c p=5 write(*,*) c! 53.module linklist type student integer :: num integer :: Chinese, English, Math, Science, Social end type type datalink type(student) :: item type(datalink), pointer :: next end type contains function SearchList(num, head)implicit none integer:: num type(datalink),pointer::head,p type(datalink),pointer::SearchList p=>head nullify(SearchList) do while( associated(p) )if ( p%item%num==num ) then SearchList => p return end if p=>p%next end do return end function end module linklist program ex1016use linklist implicit none character(len=20)::character(len=80):: tempstr type(datalink),pointer::head type(datalink),pointer:: p type(student), allocatable :: s(:)integer i,error,size write(*,*) ":"read(*,*)open(10, , status="old", iostat=error)if ( error/=0 ) then write(*,*) "Open !"stop end if allocate(head) nullify(head%next)p=>head size=0read(10, "(A80)") tempstr !读入第一行字符串 ,不需要处理它!读入每一位学生的成绩do while(.true.)read(10,fmt=*,iostat=error) p%item if( error/=0) exit size=size+1allocate(p%next,stat=error)! 新增下一个数据if ( error/=0 ) then write(*,*) "Out of memory!"stop end if p=>p%next !移动到链表的下一个数据nullify(p%next)end do write(*,"('总共有 ',I3,'位学生 ')")size allocate(s(size))p=>head do i=1,size s(i)=p%item p=>p%next end do do while(.true.)write(*,*) "要查询几号同学的成绩?"read (*,*) i if ( i<1 .or. i>size ) exit !输入不合理的座号write(*,"(5(A6,I3))")"中文 ",s(i)%Chinese,&" 英文 ",s(i)%English,&" 数学 ",s(i)%Math,&" 自然",s(i)%Science,&" 社会 ",s(i)%Social end do write(*,"(' 座号 ',I3,' 不存在 ,程序结束 .')") i stop end program4.module typedef implicit none type:: datalink integer:: i type(datalink), pointer:: next end type datalink end module typedef program ex1012use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:'read(*,*) n allocate( head )head%i=1nullify(head%next)p=>head do i=2,n allocate(p%next,stat=err )if (err/= 0)then write(*,*)'Out of memory!' stop end if p=>p%next p%i=i end do nullify(p%next)p=>head do while(associated(p))write(*,"(i5)") p%i p=>p%next end do!释放链表的存储空间p=>head do while(associated(p))next => p%next deallocate(p)p=>next end do stop end program第十一章1.module utility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r)real, parameter:: PI=3.14159real r CircleArea=r*r*PI return end function real function RectArea(a,b)real a,b RectArea=a*b return end function end module program main use UTILITY implicit none write(*,*) area(1.0)write(*,*) area(2.0,3.0) stop end program2.module time_utility implicit none type :: time integer::hour,minute,second end type time interface operator(+)module procedure add_time_time end interface contains function add_time_time( a, b )implicit none type(time) :: add_time_time type(time),intent(in)::a,b integer::seconds,minutes,carry seconds=a%second+b%second carry=seconds/60 minutes=a%minute+b%minute+carry carry=minutes/60 add_time_time%second=mod(seconds,60)add_time_time%minute=mod(minutes,60) add_time_time%hour=a%hour+b%hour+carry return end function add_time_time subroutine input( a )implicit none type(time), intent(out) :: a write(*,*) " Input hours:"read(*,*)a%hour write(*,*)"Input minutes:"read(*,*)a%minute write(*,*)"Input seconds:"read (*,*)a%second return end subroutine input subroutine output( a )implicit none type(time), intent(in)::a write(*,"(I3,' hours',I3,' minutes',I3,' seconds')" ) a%hour,a%minute,a%second return end subroutine output end module time_utility program main use time_utility implicit none type(time):: a,b,c call input(a)call input(b)c=a+b call output(c)stop end program main3.module rational_utility implicit none private public:: rational, & operator(+),operator( -),operator(*),&operator(/),assignment(=),operator(>),& operator(<),operator(==), operator(/=),&output,input type:: rational integer :: num,denom end type rational interface operator(+)module procedure rat__rat_plus_rat end interface interface operator( -)module procedure rat__rat_minus_rat end interface interface operator(*)module procedure rat__rat_times_rat end interface interface operator(/)module procedure rat__rat_div_rat end interface interface assignment(=)module procedure rat_eq_rat module procedure int_eq_rat module procedure real_eq_rat endinterface interface operator(>)module procedure rat_gt_rat end interface interface operator(<)module procedure rat_lt_rat end interface interface operator(==) module procedure rat_compare_rat end interface interface operator(/=)module procedure rat_ne_rat end interface contains function rat_gt_rat(a,b)implicit none logical :: rat_gt_rat type(rational),intent(in)::a,b real::fa,fb fa=real(a%num)/real(a%denom)fb=real(b%num)/real(b%denom)if(fa>fb ) then rat_gt_rat=.true.else rat_gt_rat=.false.end if return end function rat_gt_rat function rat_lt_rat(a,b)implicit none logical:: rat_lt_rat type(rational),intent(in)::a,b real::fa,fb fa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom)if( fb>fa) then rat_lt_rat=.true.else rat_lt_rat=.false.end if return end function rat_lt_rat function rat_compare_rat(a,b)implicit none logical:: rat_compare_rat type(rational), intent(in)::a,b type(rational)::c c=a-b if ( c%num==0)then rat_compare_rat=.true.else rat_compare_rat=.false.end if return end function rat_compare_rat function rat_ne_rat(a,b)implicit none logical:: rat_ne_rat type(rational),intent(in)::a,b type(rational):: c c=a-b if ( c%num==0)then rat_ne_rat=.false.else rat_ne_rat=.true.end if return end function rat_ne_rat subroutine rat_eq_rat(rat1, rat2)implicit none type(rational),intent(out)::rat1type(rational),intent(in)::rat2rat1%num= rat2%num rat1%denom=rat2%denom return end subroutine rat_eq_rat subroutine int_eq_rat( int, rat )implicit none integer, intent(out):: int type(rational), intent(in):: rat int= rat%num/rat%denom return end subroutine int_eq_rat subroutine real_eq_rat( float,rat)implicit none real,intent(out)::float type(rational),intent(in):: rat float = real(rat%num) / real(rat%denom)return end subroutine real_eq_rat function reduse( a )implicit none type(rational), intent(in)::a integer::b type(rational)::reduse b=gcv_interface(a%num,a%denom)reduse%num=a%num/b reduse%denom= a%denom/b return end function reduse function gcv_interface(a,b)implicit none integer, intent(in) :: a,b integer :: gcv_interface if ( min(a,b) .eq. 0 ) then gcv_interface=1return end if if(a==b)then gcv_interface=a return else if(a>b)then gcv_interface=gcv(a,b)else if(a<b)then gcv_interface=gcv(b,a)end if return end function gcv_interface recursive function gcv(a,b) result(ans)implicit none integer, intent(in) :: a,b integer:: m integer :: ans m=mod(a,b)select case(m)case(0)ans=b return case(1)ans=1return case default ans=gcv(b,m)end select return end function gcv function rat__rat_plus_rat( rat1,rat2)implicit none type(rational) :: rat__rat_plus_rat type(rational), intent(in) :: rat1,rat2type(rational) :: act act%denom= rat1%denom * rat2%denom act%num= rat1%num*rat2%denom + rat2%num*rat1%denom rat__rat_plus_rat =reduse(act)return end function rat__rat_plus_rat function rat__rat_minus_rat(rat1,rat2)implicit none type(rational):: rat__rat_minus_rat type(rational),intent(in)::rat1,rat2 type(rational):: temp temp%denom= rat1%denom*rat2%denom temp%num= rat1%num*rat2%denom- rat2%num*rat1%denom rat__rat_minus_rat= reduse(temp) return end function rat__rat_minus_rat function rat__rat_times_rat(rat1,rat2)implicit none type(rational) :: rat__rat_times_rat type(rational), intent(in) :: rat1, rat2 type(rational):: temp temp%denom= rat1%denom*rat2%denom temp%num= rat1%num *rat2%num rat__rat_times_rat= reduse(temp)return end function rat__rat_times_rat function rat__rat_div_rat( rat1,rat2)implicit none type(rational) :: rat__rat_div_rat type(rational), intent(in) :: rat1, rat2type(rational) :: temp temp%denom= rat1%denom*rat2%num temp%num= rat1%num* rat2%denom rat__rat_div_rat =reduse(temp)return end function rat__rat_div_rat subroutine input(a)implicit none type(rational),intent(out):: a write(*,*)" 分子 :"read(*,*)a%num write(*,*)" 分母 :"read(*,*)a%denom return end subroutine input subroutine output(a)implicit none type(rational), intent(in) :: a if ( a%denom/=1 ) then write(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom else write(*,"(I3)" )a%num end if return end subroutine output end module rational_utility program main use rational_utility implicit none type(rational) :: a,b,c call input(a)call input(b)c=a+b write(*,*)"a+b="call output(c)c=a-b write(*,*)"a -b="call output(c)c=a*b write(*,*)"a*b="call output(c)c=a/b write(*,*)"a/b="call output(c)if (a>b) write(*,*) "a>b"if (a<b) write(*,*) "a<b"if (a==b) write(*,*) "a==b"if (a/=b) write(*,*) "a/=b" stop end program main4.module vector_utility implicit none type vector real x,y end type interface operator(+)module procedure vector_add_vector end interface interface operator( -) module procedure vector_sub_vector end interface interface operator(*)module procedure real_mul_vector module procedure vector_mul_real module procedure vector_dot_vector end interface interface operator(.dot.)module procedure vector_dot_vector end interface contains type(vector) function vector_add_vector(a,b) type(vector), intent(in) :: a,b vector_add_vector = vector(a%x+b%x, a%y+b%y)end function type(vector) function vector_sub_vector(a,b)type(vector),intent(in)::a,b vector_sub_vector= vector(a%x-b%x, a%y-b%y)end function type(vector)function real_mul_vector(a,b)real, intent(in):: a type(vector),intent(in)::b real_mul_vector = vector(a*b%x, a*b%y)end functiontype(vector)function vector_mul_real(a,b) type(vector), intent(in) :: a real, intent(in) :: b vector_mul_real = real_mul_vector(b,a) end function real function vector_dot_vector(a,b)type(vector), intent(in) ::a,b vector_dot_vector= a%x*b%x+a%y*b%y end function subroutine output(vec) type(vector) :: vec write(*,"('('F6.2','F6.2')')")vec end subroutine end module program main use vector_utility implicit none type(vector)a,b,c a=vector(1.0, 2.0) b=vector(2.0, 1.0)c=a+b call output(c)c=a-b call output(c)write(*,*)a*b end program main。
fortran课后习题解答
!习题4-1!写出逻辑表达式的值PROGRAM XITI4_1REAL::A=2,B=7.5,C=-3.6LOGICAL::L1=.TRUE.,L2=.FALSE.PRINT*,A-7<B-6.5PRINT*,.NOT.L2.OR.B-A<=C/2.AND.C>=-3.6PRINT*,L2PRINT*,L1.EQV..NOT.L2.AND.L1.OR.3*A<=4-BPRINT*,ABS((C-A)-(B*A-C))<1E-6.OR.L1PRINT*,(A+C>B.AND.C**2>=10.0).NEQV.(L1.OR.L2) END!习题4-2!使用CASE结构PROGRAM CHENGJIINTEGER::GPRINT*,'请输入学生的成绩：'READ*,GSELECT CASE(G)CASE(90:100)PRINT*,'very good'CASE(80:89)PRINT*,'good'CASE(60:79)PRINT*,'pass'CASE(0:59)PRINT*,'fail'CASE DEFAULTPRINT*,'ERROR'END SELECTEND!习题4-2!使用IF结构PROGRAM MAINIMPLICIT NONEREAL::GPRINT*,'请输入学生的成绩：'READ*,GIF(G>=0.AND.G<=100)THENIF(G>=90)THENPRINT*,'VERY GOOD'ELSEIF(G>=80)THENPRINT*,'GOOD'ELSEIF(G>=60)THENPRINT*,'PASS'ELSEPRINT*,'FAIL'END IFELSEPRINT*,'ERROR'ENDIFEND PROGRAM MAIN!习题4-3PROGRAM MAINIMPLICIT NONEREAL::X,YPRINT*,'请输入X的值：'READ*,XIF(X>=0.AND.X<15)THENY=40*X/15+10PRINT*,'Y=',YELSEIF(X>=15.AND.X<30)THENY=50PRINT*,'Y=',YELSEIF(X>=30.AND.X<45)THENY=50-10*(X-30)/15PRINT*,'Y=',YELSEIF(X>=45.AND.X<75)THENY=40+20*(X-45)/30PRINT*,'Y=',YELSEIF(X>=75.AND.X<90)THENY=60-10*(X-75)/15PRINT*,'Y=',YELSEPRINT*,'X不在定义域内，无函数值' END IFEND PROGRAM MAIN!习题4-4PROGRAM MAINIMPLICIT NONEREAL::X1,X2,X3,Y1,Y2,Y3,X,YPRINT*,'INPUT X1,X2,X3,Y1,Y2,Y3'READ*,X1,X2,X3,Y1,Y2,Y3PRINT*,'INPUT X'IF(X>=X1.AND.X<X2) THENY=(Y2-Y1)/(X2-X1)*(X-X1)+Y1 ELSE IF(X>=X2.AND.X<=X3) THEN Y=(Y3-Y2)/(X3-X2)*(X-X2)+Y2 END IFPRINT*,YEND PROGRAM MAIN!习题4-5program mainimplicit nonereal::x,yprint*,"请输入购物额"read*,xif(x>=1000) theny=0.8*xelseif(x>=500) theny=0.9*xelseif(x>=200) theny=0.95*xelsey=xendifprint*,"应收货款",yend!习题4-6PROGRAM MAINIMPLICIT NONEINTEGER::APRINT*,'请输入一个整数：'READ*,AIF(MOD(A,2)==0)THENPRINT*,'是偶数'ELSEPRINT*,'是奇数'END IFEND PROGRAM MAIN!习题4-7PROGRAM MAININTEGER::MPRINT*,'请输入一个整数：'IF (MOD(M,7)==0) THENPRINT*,M,'能够被7(或11、17)整除' ELSEIF (MOD(M,11)==0) THENPRINT*,M,'能够被7(或11、17)整除' ELSEIF (MOD(M,17)==0) THENPRINT*,M,'能够被7(或11、17)整除' ELSEPRINT*,M,'不能够被7，11和17整除' END IFEND PROGRAM MAIN!习题4-8!冒泡法排序PROGRAM MAINIMPLICIT NONEINTEGER::A,B,C,D,EPRINT*,'INPUT A,B,C,D'READ*,A,B,C,DIF(A>B) THENE=AA=BB=EEND IFIF(B>C) THENE=BB=CC=EEND IFIF(C>D) THENE=CC=DD=EEND IFIF(A>B) THENE=AA=BB=EEND IFIF(B>C) THENE=BB=CC=EEND IFIF(A>B) THENE=AA=BB=EEND IFPRINT*,A,B,C,DEND PROGRAM MAIN!习题4-8!选择法排序program mainimplicit noneinteger::a,b,c,d,tprint*,'please input 正整数a,b,c,d'read*,a,b,c,dif (a>b) thent=aa=bb=tendifif (a>c) thent=aa=cc=tendifif (a>d) thent=aa=dd=tendifif (b>c) thent=bb=cc=tendifif (b>d) thent=bb=dd=tendifif (c>d) thent=cc=dd=tendifprint*,a,b,c,dend program main!习题4-8program mianimplicit noneinteger::a,b,c,d,e,f,gprint*,'请输入四个数字'read*,a,b,c,de=max(a,b,c)f=min(a,b,c)g=a+b+c-e-fprint*,'四个数由小到大排列为：'if(d>=e)thenprint *,f,g,e,delseif(d>=g)thenprint *,f,g,d,eelseif(d>=f)thenprint *,f,d,g,eelseprint *,d,f,g,eendifend program mian!习题4-9program mainimplicit nonereal::a,b,c,d,x,x1,x2,r,tprint*,'请输入a,b,c：'read*,a,b,cd=b**2-4*a*cif(a==0.and.b/=0) print*,'x=',-c/bif(a==0.and.b==0.and.c==0) p rint*,"x为任意值"if(a==0.and.b==0.and.c/=0) print*,"x无解"if(a/=0.and.d>0) thenx1=(-b+sqrt(d))/(2*a)x2=(-b-sqrt(d))/(2*a)print*,'x1=',x1,'x2=',x2end ifif(a/=0.and.abs(d)<1e-6) thenx=(-b+sqrt(d))/(2*a)print*,"x=",xend ifif(a/=0.and.d<0) thenr=-b/(2*a)t=abs(sqrt(-d)/(2*a))print*,"x1=",r,"+",t,"i"print*,"x2=",r,"-",t,"i"endifend!习题4-10PROGRAM MAINIMPLICIT NONEREAL::X,Y,M,NINTEGER::ZPRINT*,'INPUT(X,Y)'READ*,X,YM=SQRT(X**2+Y**2)IF(M<=20) THENZ=2ELSEZ=1END IFPRINT '(A,I1,A)',"该点的每亩地价为：",Z,"万元。
fortran习题答案
fortran习题答案【篇一：fortran习题1答案】txt>上机目的：练习c语言的书写、循环和判断结构1. 编写程序实现摄氏度和华氏度的相互转换：f?c*9/5?32#include stdio.hint main(void){ float c,f;printf(请输入摄氏温度：\n);scanf(%f,c);f=c*9/5+32;printf(对应的华氏温度为：\n);printf(%.2f\n,f);}2. 打印出6行杨辉三角形如下图：11 11 2 11 3 3 11 4 6 4 11 5 10 10 5 1#include stdio.h#define n 6int main(){int a[n][n],i,j; for (i=0;in;i++) { a[i][0]=1; a[i][i]=1; } for(i=2;in;i++) for (j=1;ji;j++)a[i][j]=a[i-1][j-1]+a[i-1][j]; for(i=0;in;i++) {}for (j=0;j=i;j++)printf(%4d,a[i][j]); printf(\n); } return 0;3. 求出数列2/1，3/2，5/3，8/5，13/8，21/13...的前10项之和。
#include stdio.hint main(void){} float a,b,c,i,s; a=1;b=2;s=0; for (i=1;i=10;i++) { } printf(数列前10项的和为：%f\n,s); s=s+b/a; c=a+b; a=b; b=c;4. 输入若干实数，请编写程序用于统计每个正数和负数的个数。
5. 从键盘上输入三条边长，判断是否能组成三角形。
#include stdio.hint main(void){float a,b,c;printf(请输入三个边长：\n); scanf(%f%f%f,a,b,c);if (a+bca+cbb+ca) printf(这三条边可以围成三角形\n);} else printf(这三条边不可以围成三角形\n);6. 输入某个点的坐标（a, b)，判断该点是否位于圆心(x, y)、半径为r的圆内。
Fortran-第三讲(含习题课与实验一)
PROGRAM test_cycle INTEGER ::i DO i=1,5 IF (i==3) CYCLE WRITE (*,*) i END DO WRITE (*,*) ‘End of loop!’ END PROGRAM test_cycle
3.4 例程
计算1到100之间所有个位数不为6的数的和
INTEGER ::i=1,s=0 DO
s=s+i IF (i==100) EXIT i=i+1
END DO
例3.1.2：令s=1+2+3+…+n，求满足 s>5000的最小n值：
INTEGER ::i=1,s=0 DO
s=s+i IF (s>5000) EXIT i=i+1
END DO WRITE (*,*) i,s
3.3 例程
用计数循环的方法来计算s=1+2+...+100
!例程3_3_1.f90 PROGRAM example3_3_1 INTEGER :: i,s=0 DO i=1,100 s=s+i END DO WRITE(*,*) i,s END PROGRAM example3_3_1
3.4 CYCLE语句
[名称:] DO … … IF (逻辑表达式) CYCLE [名称] … … IF (逻辑表达式) EXIT [名称] … … END DO [名称]
CYCLE EXIT后面的名称是可选项，但是如果使用的话，必须和DO语句上的保持一致
3.7 嵌套循环
一个循环可以完全嵌入另外一个循环，这 种情况叫循环的嵌套
起名字： 如果交换END DO后面的inner与outer， 会出错，嵌套必须是完全包含
西安交通大学fortran习题
1二维数组的输入与输出program mai nimplicit nonein teger i,jin teger A(2,2)!若为data((A(j,i),i=1,2),j=1,2)/1,2,3,4/prin t*,Aend!结果为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*,Aend!结果为1 2 3 4实际为A(1,1)=1 A(2,1)=2 A(1,2)=3 program mai nimplicit nonein teger i,jin teger A(2,2) data((A(i,j),i=1,2),j=1,2)/1,2,3,4/write(*,"(l3,l3)")Aend!结果为1 23 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 doi=2,52 j=i A(2,2)=4 A(2,2)=4do while(j<=52) s(j)=s(j)+1 j=j+i end doend dodo i=1,52if(mod(s(i),2)==0)then write(*,*)i end if end doend program mai nII用C语言写#in clude<stdio.h> 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 IFwrite(*,*)'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,nif(n==0)the ng=0else if(n==1.or. n==2)the ng=1elseg=f( n-1)+f( n-2)end ifend fun cti onEnd program分解质因数!分解质因数program mai nimplicit nonein teger 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/cprin t*,cend doend program哥德巴赫猜想!屏幕上不能显示500行，所以不能将结果完全显示，需要将结果输入文件FUNCTION f(i)IMPLICIT NONEINTEGER i,f,hf=0if(i>1)the ndo h=2,i-1if(mod(i,h)==0)the nf=f+1 en dif end do en difend fun cti onprogram mai nimplicit none in teger(4) i,j, n,f in teger sdo n=4,600,2s=0j=0do i=1, n/2-1j=n_iif(f(i)==O.a nd.f(j)==O)then s=s+1 end ifend doif(s==0)the nprint*,n,'不满足猜想’ elseprin t*, n,send ifend doend program黄金值法解方程!将中值法中取中点的值改为取黄金点的值，理论上可以提高效率module golde n_sect ionimplicit nonereal a,b,ccontainssubrouti ne 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)<O)the nb=celsea=cend ifc=(a*0.618+b)/1.618 yc=f(c) end doend subrout inefun 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 eprint*,"请输入解的下界a"read*,aprint*,"请输入解的上界b"read*,b e=f(a)*f(b)!用一个循环来判断输入值是否合适，或者就是解if(f(a)==0)the nprin t*,aelse if(f(b)==0)the nprin t*,belsedo while(e>0)prin t*,"f(a)=,f(a);f(b)=,f(b);请重新输入下界a" read*,aprint*,"请重新输入解的下界b"read*,bend do call sub1(a,b,c) end ifprin t*,c endprogram mai nimplicit nonein teger i,jin teger a(5),b(5)data a /1,2,8,2,10/data b /2,3,4,5,6/do i=1,5do j=1,5b(j)=b(j)-1if(b(j)<1)the nb(j)=b(j)+5end ifend doprint*,a(b(1:5))!实践证明这是正确的输出方法end doend! 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 whereprint*,a(b(1:6))!实践证明这是正确的输出方法end do回文数据若干相邻想和并比较大小!1.圆盘上有如图1( 1)所示的20个数。
Fortran95第三章第四大题习题与答案
1. 计算10014131211+⋅⋅⋅++++=s 。
Program ex3_1implicit nonereal sinteger iinteger,parameter::num=100s=0do i=1,nums=s+1.0/real(i)enddoprint*,'s=',sstopEnd2. 计算121917151311++⋅⋅⋅-+-+-=n s 的前20项和。
Program ex3_2implicit nonereal sinteger i,ainteger,parameter::num=20a=1s=1.0do i=1,num-1a=-as=s+a*(1.0/real(2*i+1))enddoprint*,'s=',sstopEnd3. 计算!1!31!211n y +⋅⋅⋅+++=。
Program ex3_3implicit nonereal yinteger i,x,ny=0x=1print*,'输入一个正整数'read*,ndo i=1,nx=x*iy=y+1.0/real(x)enddoprint*,'y=',ystopEnd4. 计算333421n y ⋅⋅⋅+++=，当y 值大于1000时停止计算并输出n 和y 值。
Program ex3_4implicit noneinteger n,yn=1y=1do while(y<=1000)n=2*ny=y+n**3enddoprint*,'n=',n/2,'y=',y-n**3stopEnd5. 利用以下展开式357sin 3!5!7!x x x x x =-+-+⋅⋅⋅计算sin x 的近似值。
x 值从键盘输入，当式中一项的绝对值小于510-时结束计算并输出sin x 值和项数。
Program ex3_5implicit noneinteger i,j,k,n,signreal x,y,sum,mid,mulprint*,'请输入一个角度值:'read*,xy=x*3.14159/180.0sign=1n=1j=1k=3mul=1.0mid=1.0sum=ydodo i=j,kmid=mid*ymul=mul*real(i)enddoif((mid/mul)>1.0E-5)thensign=-signsum=sum+sign*(mid/mul)j=k+1k=2*n+1elseexitendifenddoprint*,'sin(',x,')=',sum,'n=',nstopEnd6.有一个30个数的数列，头两个数为0和1，第三个数是第一、第二个数之和，第四个数是第二、第三个数之和，以后每个数都是其前两个数之和。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
编程序（20*1=20）
主要内容
Fortran基础知识
变量类型与表达式 例程和针
简单Fortran 90程序的构造形式：
[PROGRAM 程序名]
[声明语句] [执行语句] END [PROGRAM [MONEY]] 一个程序，只有end不能省，其他都是可选的
Example
正确的写法 axis1=1; axis2=2; axis3=3 Area = sqrt(half * (half - axis1) * (half - &
axis2) * (half - axis3)) Area = sqrt(half * (half - axis1) * (half- & & axis2) * (half - axis3))
复数型（COMPLEX）
复数型变量
– (r, i) – 复数型常量的类型参数，取实部和虚部的实数种类参数的极 大值
复数由实部和虚部组成，z=x+yi，x为实部，y为虚部，
x、y皆为实型变量 设定 z = (x, y) ! a = x + iy z = (1.5, 2.5) ! a = 1.5 + 2.5i z = 1.5 ! a = 1.5 + 0i Z= (0, 2.5) ! a= 0 + 2.5i
声明
Example：
implicit integer(A,B,C) ! A,B,C开头的变量都视为整数 implicit integer(A-F,I,K) ! A到F及I,K开头的变量都视为 整数 implicit real(M-P) ! M到P开头的变量都视为浮点数 implicit none ! 关闭隐含规则，所有的变量都要事先声 明
例子
―WHAT‘S YOUR NAME?‖
‗WHAT‘‘S YOUR NAME?‘ ― ‖
―Can I help you?‖
―New world record!!!‖
算术表达式
运算符 + * / 优先级增加 ** （） 运算级相同：从左至右 连续的乘幂运算：从右至左 计算的结果是把“=”右边的结果传给左边的变 量 整数之间的除法，结果也是整数！ 如果不能整除，小数部分无条件舍去！
逻辑型（LOGICAL）
逻辑型变量 – LOGICAL L – LOGICAL([KIND=]N) L 逻辑型常量 – .TRUE.（逻辑真） – .FALSE.（逻辑假）
字符型（CHARACTER）
字符型变量 CHARACTER [([LEN=]len)] CHARACTER [([LEN=]len [, [KIND=]n])] CHARACTER [(KIND=n [, LEN=len])] 字符串有两个可选参数：长度参数、种类参数 种类参数总是1，即一个字符占一个存储字节 假如两个可选参数都没给出，缺省值取1： character c 若只给出一个参数，则代表长度参数：character(20) c 若给出两个参数，则依次为长度参数和种类参数（种 类参数智能为1）：character(20, 1) c 若采取关键字声明形式，则参数的顺序可以任意： character(KIND=1, LEN=20) c
所有的声明语句必须在执行语句之前
一个项目中只能有一个主程序
Fortran 77 & Fortran 90
Fortran 77
变量名长度 书写格式 行宽 注释 续行标志 6 固定格式 7～72 第一列为 C/c/*
第六列0以外的 任何字符
Fortran 90
31 自由格式 0～132 任意位置! &
变量名（Variable name）
有效的变量名
area distance z123456789 long_axis_of_elliptic_circle a3b4c5 abstract_3 TimeAndSpace century____
area，AREA，aREa等等都是一个变量
变量名（Variable name）
Fortran 课程要点总结
2014/7/12
2012-2013学年第二学期《工程分析程序设计》考试安排 考试时间：2012年6月16日（ 周日晚） 晚7:00-9:30 班级 考试地点 C204 主监 副监
题型
填空（2*10=20）
判断正误（2*5=10） 选择（2*10=20）
读程序，回答问题（10*2=20）
例子
写出10以内的素数的逻辑表达式 分析： – 要求的数应该同时满足以下条件，即为并的关系
• • • • 大于1 小于10 除以2余数不为0 除以3余数不为0
N.GT.1.AND.N.LT.10.AND.MOD(N,2).NE.0.A
ND.MOD(N,3).NE.0
例子
写出1000以内的含有3或者能被3整除的整数 分析：
无效的变量名
This_is _a_very_long_variable_name 3_day $600 my-help exchange rate U.S.A Ask? ―UK‖ b/a engry&power wang@ fluent 6.3
语句（Statement）
语句是Fortran程序的基本单位，一条语句可包含0～
错误的写法 axis1=1, axis2=2, axis3=3 Area = sqrt(half * (half - axis1) * (half -
&axis2) * (half - axis3))
引号的使用
a=―Hello‖ ! FOTRAN 90可以用双引号界定字符串 b=‗Hello‘ ! FOTRAN 77只能用单引号界定字符串 c=―That‘s right.‖ ! 用双引号界定字符串，可以在字串 中任意使用单引号 d=‗That‘‘s right‘ !用单引号界定字符串时，输出单引号 要连续使用两个单引号 e=―That‘s ―‖right‖‖.‖ !用双引号界定字符串时，输出双 引号也要连续用两个双引号
算术表达式
2**3**2 2A ： 2*A arcsinx ：ASIN(X) (A+B)(C+D) ： (A+B)*(C+D)
( A B )(C D ) ： ((A+B)*(C+D))/(2*(E+F)) 2 (E F )
d x y z
2 2
2
d=sqrt(x**2+y**2+z**2)
132个字符； 除赋值语句外，所有的语句都从一个关键字开始； 一般情况下，每行一条语句； 如果一行有多条语句，它们之间以分号分隔 假如一条语句一行写不完，允许出现续行，但要求被 续行最后的非空白字符为“&‖ 续行从下一行（非注释行）的第一个非空白字符开始， 如果下一行的非空白字符为“&‖，则续行从该字符后 的第一个字符开始。 Fortran 90 允许出现多达39个续行。
Example
program convert real a a = 10 / 4 / 0.5 print *, 'a = ', a end !Integer a
关系运算符
F90 F77 == .EQ.
/= .NE. > .GT.
功能/意义 判断是否「等于」
判断是否「不相等」 判断是否「大于」
>= .GE. < .LT. <= .LE.
关系表达式
关系表达式的结果是一个逻辑量 .TRUE. 或者.FALSE.,输出时为T或者F Print*，3.GT.5 !输出为F 关系表达式允许不同类型的算术表达式比较 Print*, 8.EQ.(5/2+1.5)*2 !输出结果为F 比较两个实数大小时，由于机内表示为近似值， 所以不应当做两个数来比较 ABS(A-B).LE.1E-06 !表示A和B误差的绝对值小于10-6时，认为二者 相等
找错误
real(8) parameter a
integer(4) parameter ::b Complex, parameter c=(1.0,2.0) real(8), parameter a
integer(4), parameter ::b
Complex, parameter :: c=(1.0,2.0)
– 非数值型
• 字符型 CHARACTER • 逻辑型（布尔型） LOGICAL
自定义数据类型（派生数据类型）
变量声明及其初始化
声明部分必须出现在执行部分之前，而
不能将声明语句插在执行部分之中。 Fortran 90： 数据类型 [[, 属性]::] 变量列表
– DIMENSION、PARAMETER、TARGET、 – POINTER、ALLOCATABLE、INTENT – ::可以省略，但如果在声明的同时给变量赋 初值，则不能省略
注意： – IMPLICIT指令要马上接在PROGRAM指令 的下一行，不能放在其它位置
主要内容
Fortran基础知识
变量类型与表达式 例程和模块
控制结构
数组
派生类型和指针
数据类型
固有数据类型 – 数值型 (numerical)
• 整型 INTEGER • 实型 REAL • 复数型 COMPLEX
逻辑运算符——两个逻辑运算 式间的运算关系
.AND.
交集，如果两边的式子都成立，整 个条件就成立 或集，两边的式子只要有一个成立， 整个条件就成立 逻辑非，如果后面的式子不成立， 整个式子就算成立 两个式子的逻辑运算结果相同时， 整个式子就成立