Fortran95习题答案.doc

第四章1.program main implicit none write(*,*) have a good time. write(*,*) thats not bad. write(*,*) mary isnt my name.end gram main real, parameter : pi=3 implicit none.14159 real radius write(*,*) 请输入半径长 read(*,*) radius write(*,( 面积=f8. 3) radius*radius*piend gram main implicit none real grades write(*,*) 请输入成绩 read(*,*) grades write(*,( 调整后成绩为 f8.3) sqrt(grades)*10.0end eger a,breal ra,rba=2b=3ra=2.0rb=3.0write(*,*) 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.54 write(*,(f8.3米 =f8.3厘米 =f8.3英寸) d%meter, d%cm, d%inchend program第五章1.program main implicit none integer money real tax write(*,*) 请输入月收入 read(*,*) money if ( money1000 ) then tax = 0.03 else if ( money5000) then tax = 0.1 else tax = 0.15 end if write(*,( 税金为 i8) nint(money*tax)end gram 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(*,*) tvend gram main implicit none integer age, money real tax write(*,*) 请输入年龄 read(*,*) age write(*,*) 请输入月收入 read(*,*) money if ( age50 ) then if ( money1000 ) then tax = 0.03else if ( money5000 )then tax = 0.10else tax = 0.15end if else if ( money1000 ) then tax = 0.5else if ( money5000 )then tax = 0.7else tax = 0.10end if end if write(*,( 税金为 i8) nint(money*tax)end gram 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 = 365 end if write(*,(这一年有i3天) days stopend program第六章1.program main implicit none integer i do i=1,5 write(*,*) fortran end do stopend gram main implicit none integer i,sum sum = 0 do i=1,99,2 sum = sum+i end do write(*,*) sum stopend gram main implicit none integer, parameter : answer = 45 integer, parameter : max = 5 integer weight, i do i=1,max write(*,*) 请输入体重read(*,*) weightif ( weight=answer ) exit end do if ( i=max ) then write(*,*) 猜对了 else write(*,*) 猜错了 end if stopend gram main implicit none integer, parameter : max=10 integer i real item real ans ans = 1.0 item = 1.0 do i=2,max item = item/real(i) ans = ans+item end do write(*,*) ans stopend gram 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+1end if end do write(*,(a79) output stopend 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) stopend eger a(5,5) ! 5*5=25integer b(2,3,4) ! 2*3*4=24integer c(3,4,5,6) ! 3*4*5*6=360integer d(-5:5) ! 11integer 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 stopend gram mainimplicit 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-1 do 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 ifend do end do write(*,(10i4) a stopend5.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 stopend programsubroutine circlearea(radius, area) implicit none real, parameter : pi=3.14159 real radius, area area = radius*radius*pi returnend gram main implicit none real radius real, external : circlearea write(*,*) 请输入半径长 read(*,*) radius write(*,( 面积 = f8.3) circlearea(radius) stopend programreal function circlearea(radius) implicit none real, parameter : pi=3.14159 real radius circlearea = radius*radius*pi returnend gram main implicit none call bar(3) call bar(10) stopend programsubroutine 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 returnend gram main implicit none integer, external : add write(*,*) add(100)end programrecursive integer function add(n) result(sum) implicit none integer, intent(in) : n if ( n0 ) then sum=0return else if ( n=1 ) then sum=nreturn end if sum = n + add(n-1) returnend gram main implicit none integer, external : gcd write(*,*) gcd(18,12)end programinteger 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 returnend gram 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,maxx py = (maxy/2)*sin(x)+maxy/2+1 call putchar(px,py)x=x+xinc end do call updatescreen() stopend 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 pausecount = 0 end if end do else write(*,*) trim(filename), doesnt exist. end if gram 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)-3 ) end do write(*,(a70) buffer end do else write(*,*) trim(filename), doesnt exist. end if gram 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%socials%total = s%chinese+s%english+s%math+s%science+s%socialtotal%chinese = total%chinese+s%chinesetotal%english = total%english+s%englishtotal%math = total%math+s%mathtotal%science = total%science+s%sciencetotal%social = total%social+s%socialtotal%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) gram 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), doesnt exist. end if stopend5.module typedef type student integer : numinteger : chinese, english, math, natural, socialinteger : totalinteger : rank end typeend moduleprogram 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)%chinesetotal%english = total%english + s(i)%englishtotal%math = total%math + s(i)%mathtotal%natural = total%natural + s(i)%naturaltotal%social = total%social + s(i)%socialtotal%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) stopend programsubroutine 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 awrite(*,*) p ! 1p=bwrite(*,*) p ! 2p=cp=5write(*,*) c ! 53.module linklist type student integer : numinteger : chinese, english, math, science, social end type type datalink type(student) : item type(datalink), pointer : next end typecontains function searchlist(num, head) implicit noneinteger : numtype(datalink), pointer : head, ptype(datalink), pointer : searchlistp=headnullify(searchlist)do while( associated(p) ) if ( p%item%num=num ) then searchlist = preturn end if p=p%nextend doreturn end functionend module linklistprogram 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(*,*) 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%itemif ( error/=0 ) exitsize=size+1allocate(p%next, stat=error) ! 新增下一个数据if ( error/=0 ) then write(*,*) out of memory! stopend ifp=p%next ! 移动到链表的下一个数据nullify(p%next) end do write(*,(总共有,i3,位学生) size allocate( s(size) ) p=head do i=1,size s(i)=p%itemp=p%next end do do while(.true.) write(*,*) 要查询几号同学的成绩?read (*,*) iif ( isize ) 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 datalinkend module typedefprogram ex1012 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%nextdeallocate(p)p=next end do stopend program第十一章1.module utility implicit none interface area module procedure circleareamodule procedure rectarea end interfacecontains real function circlearea(r) real, parameter : pi=3.14159 real rcirclearea = r*r*pireturn end function real function rectarea(a,b) real a,brectarea = a*breturn end functionend moduleprogram main use utility implicit none write(*,*) area(1.0) write(*,*) area(2.0,3.0) stopend program2.module time_utility implicit none type : time integer : hour,minute,second end type time interface operator(+) module procedure add_time_time end interfacecontains 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