Fortran程序设计课后习题答案方便

1、第四章1. program main implicit none write(*,*) Have a good time. write(*,*) Thats not bad. write(*,*) Mary isnt my name. end program2. program main real, parameter : PI=3 implicit none.14159 real radiuswrite(*,( 面 积 =f8. 3)implicit none real grades 调整后成绩为 f8.3)write(*,*) 请 输 入 半 径 长 read(*,*) radiusrad

2、ius*radius*PI end program 3.program main write(*,*) 请输入成绩 read(*,*) grades write(*,(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

3、 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第五章请输税tv1. program main implicit none integer money real tax write(*,*) 入月收入 read(*,*) money if ( money1000 ) then tax = 0.03 else i

4、f ( money5000) 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) write(*,*) 请输入星期几 read(*,*) day select case(day) case(1,4) tv= 新闻 case(2,5) tv = tv = 电影 case default电视剧 case(3,6) tv = 卡通 case(7) write(*,*) 错

5、误的 输入 stop end select write(*,*) tv end program3. program main implicit none integer age, money real tax write(*,*) 请 输入年龄 read(*,*) age write(*,*) 请输入月收入 read(*,*) money if ( age50 ) then if ( money1000) then tax = 0.03 else if ( money5000) then tax = 0.10 else tax = 0.15 end if else if ( money1000

6、 ) then tax =0.5 else if ( money5000 )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 )

7、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 end do stop end program 2.program main implicit none sum+i end do write(*,*) sum3. program main implicit noneinte

8、ger i do i=1,5 write(*,*) Fortraninteger i,sum sum = 0 do i=1,99,2 sum = stop end programinteger, 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

9、 if stop end program 4. program main implicit none integer, parameter : max=10 integer i real item real ans ans = 1.0 item = 1.0 do i=2,max item ans = ans+item end do write(*,*) ans stop end program5. program main implicit none character(len=length) : input, output integer i,j 字串 read(*,(A79) /= ) t

10、hen write(*,(A79) output= item/real(i)integer, parameter write(*,*) input j=1 do i=1, len_trim(input) output(j:j)=input(i:i) j=j+1 stop end program 第七章ifendiflength = 79 请输入一个 input(i:i)end gram main implicit none integer, parameter : integer : a(max) = (/ (2*i, i=1,10) /) integer : t ! sum()

11、 write(*,*) real(sum(a)/real(max) stop end programmax =integer i10是 fortran 库函数2. 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

12、 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, sizeif ( a(i) a(j) ) then ! a(i)跟 a(j) 交换 t=a(i)a(i)=a(j) a

13、(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(rad

14、ius, area) implicit nonereal radius, area area = radius*radius*PIreal, parameter : PI=3.14159 return end subroutinereal, external : CircleAreawrite(*,(面 积 = F8.3)2.program main implicit none real radius write(*,*) 请输入半径 长 read(*,*) radius subroutine bar(length) implicit none integer, intent(in) : le

15、ngth integerCircleArea(radius)stop end programreal function CircleArea(radius)implicit none real, parameter : PI=3.14159 radius*radius*PI return end function3. program main implicit none call bar(3) callreal radiusCircleArea =bar(10) stop end programi character(len=79) : string string= do i=1,length

16、 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 ( n0 ) then sum=0 return else if ( n=1 )then sum=n return end if

17、 sum = n + add(n-1) return end function5. program main implicitnone integer, external : gcd write(*,*)gcd(18,12)end program integerfunction 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 en

18、d 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=StartX do px=1,m

19、axx py = (maxy/2)*sin(x)+maxy/2+1 call PutChar(px,py) x=x+xinc end docall UpdateScreen() stop end program第九章1. program mainimplicit nonecharacter(len=79)filenamecharacter(len=79) : buffer integer, parameter : fileid = 10 integer count integer : status = 0 logical alive write(*,*) Filename: read(*,(A

20、79)filename inquire( file=filename, open(unit=fileid, file=filename, &exist=alive) if (access=sequential,alive ) then status=old)fmt=(A79), iostat=status )count = 0 do while(.true.) read(unit=fileid,buffer if ( status/=0 ) exit !没有资料就跳出循环 write(*,(A79)buffer count = count+1 if ( count=24 ) then paus

21、e count = 0 end if end do else write(*,*) TRIM(filename), doesnt exist. end if stop 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

22、( file=filename, open(unit=fileid, file=filename, &exist=alive) if ( access=sequential,alive ) thenstatus=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)bu

23、fferend do else write(*,*) TRIM(filename), doesnt exist. end if stop end 3. 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,re

24、cl=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 =

25、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(*,

26、(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

27、 character(len=79) : buffer integer, parameter : fileid = 10 integer i integer : status = 0 logical alive write(*,*) Filename: read (*,(A79)inquire( file=filename, exist=alive) file=filename, & access=sequential, read(unit=fileid, fmt=(A79), ! 没 有数据 就跳 出循环 ichar(buffer(i:i)-(mod(i-1,3)+1) end do els

28、e write(*,*)filename i open(unit=fileid, do while(.true.) if ( status/=0 buffer(i:i) write(*,(A70) 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

29、 none integer, parameter : fileid=10 integer, parameter : type(student) : s(students) ! 算平均分数用 file=grades.txt,status=old, write(*,*) Open grades.txt tempstr ! 读入第一行文字 生 的 成 绩 do i=1,students read(fileid,*) s(i)%English, &s(i)%Math, s(i)%Natural, s(i)%Social算总分 s(i)%Total = s(i)%Chinese + s(i)%Engli

30、sh + & s(i)%Natural + s(i)%Social total%Chinese s(i)%English total%Natural total%Total = total%Total + s(i)%Total 新输出每位学生成绩 write(*,(8A7) , 总分, 名次 do i=1,students write(*,(8I7) s(i) end do ! 输 出 平 圴 分 数 write(*,(A7,6F7.1) real(total%Chinese)/real(students),& real(total%Math) /real(students),& real(t

31、otal%Social) /real(students),& stop end program subroutine sort(s,n) use typedef implicit none integer n type(student) ( s(i)%total 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 t

32、ype 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=nu)m t hen SearchL

33、ist = p return end if p=p%next end do return end function end module linklist program ex1016 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(*,*

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

35、f ( 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, 位学生 ) sizei,n,err write(*,*) Input N: read(*,*) n nullify(head%next) p=head do i=2,n if ( err /= 0 ) thenw

36、rite(*,*) Out of memory! stopp=p%next p%i=i end do nullify(p%next)integer head%i=1 stat=err ) end if while(associated(p) write(*, (i5) ) p%i p=p%next end doallocate( head ) allocate( p%next,放链表的存储空间 deallocate(p) p=nextp=head do while(associated(p) end do stop end program第十一章implicit none interface

37、area procedure RectArea end interfacenextp=head do 释 = p%next1. module utilityCircleArea modulefunction CircleArea(r) real, parameter : PI=3.14159 real r CircleArea = r*r*PI return end function real function RectArea(a,b) RectArea = a*b return end function end module program main use UTILITY implici

38、t none write(*,*) area(1.0) write(*,*) area(2.0,3.0) stop endmodulecontainsprocedurerealreala,ballocate( s(size) ) p=head doi=1,size s(i)=p%item p=p%next enddodo while(.true.)write(*,*) 要 查 询 几 号 同 学 的 成 绩 ? read (*,*)i if( isize ) exit !输入不合理的座号 write(*,(5(A6,I3) 中文,s(i)%Chinese,&英文 ,s(i)%English,&

39、 数学 ,s(i)%Math,&自 然 ,s(i)%Science,&社会,s(i)%Social end dowrite(*,(座号,I3, 不存在, 程序结束 .) i stopend program4. module typedefimplicitnone type : datalink integer: itype(datalink), pointer : next end type datalink end module typedef program ex1012 use typedef implicit none type(datalink) , pointer : p, hea

40、d, nextprogram2. 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,binteger : seconds,

41、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), in

42、tent(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%minu

43、te,a%second return end subroutine output endmodule time_utility program main use time_utility 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(*),& assignm

44、ent(=),operator(),& operator(/=),& output, input type : rational denom end type rational interfaceimplicit noneoperator(/),operator(=),rat_rat_plus_rat end interface interface operator(-) rat_rat_minus_rat end interface interface operator(*) rat_rat_times_rat end interface interface operator(/) rat_

45、rat_div_rat end interface interface assignment(=) rat_eq_rat interface interface interface interfacemodule procedure int_eq_rat interface operator() interface operator() interface operator(=) interface operator(/=)operator( fb ) then rat_gt_rat=.true. else rat_gt_rat=.false. return end function rat_

46、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 ) thenrat_lt_rat=.true.elserat_lt_rat=.false.return end function rat_lt_rat function rat_compare_rat(a,b) implicit non

47、e type(rational) : rat_compare_rat=.true. return end function rat_compare_rat function rat_ne_rat(a,b) implicit none logical type(rational) : c else rat_ne_rat=.true. subroutine rat_eq_rat(logicalrat_compare_ratc c=a-b else: rat_ne_rat c=a-b if end if return rat1, rat2 )realfa,fbend ifend iftype(rat

48、ional), intent(in) if ( c%num = rat_compare_rat=.false.: a,b) thenend iftype(rational), intent(in)( c%num=0) then rat_ne_rat=.false. end function rat_ne_rat implicit none rat1%num =type(rational),intent(out): rat1 type(rational), intent(in) : rat2 rat2%num rat1%denom = rat2%denom return end subrouti

49、ne rat_eq_rata,bsubroutine int_eq_rat( int, rat ) implicit none integer, intent(out): int type(rational), intent(in) : rat int= rat%num / rat%denom return endsubroutine int_eq_rat subroutine real_eq_rat( float, rat ) implicit none real, intent(out) : float type(rational), intent(in) : rat float = re

50、al(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 functionnone integer, intent(in) : if ( min(a,b) .eq. 0 ) thenreduse function gcv_interface(a,b) im