fortran课后习题答案

合集下载

Fortran95程序设计习题答案第十一章3

module rational_utilityimplicit noneprivatepublic :: rational, &operator(+), operator(-), operator(*),&operator(/), assignment(=),operator(>),&operator(<), operator(==), operator(/=),&output, inputtype :: rationalinteger :: num, denomend type rationalinterface operator(+)module procedure rat__rat_plus_ratend interfaceinterface operator(-)module procedure rat__rat_minus_ratend interfaceinterface operator(*)module procedure rat__rat_times_ratend interfaceinterface operator(/)module procedure rat__rat_div_ratend interfaceinterface assignment(=)module procedure rat_eq_ratmodule procedure int_eq_ratmodule procedure real_eq_ratend interfaceinterface operator(>)module procedure rat_gt_ratend interfaceinterface operator(<)module procedure rat_lt_ratend interfaceinterface operator(==)module procedure rat_compare_rat end interfaceinterface operator(/=)module procedure rat_ne_ratend interfacecontainsfunction rat_gt_rat(a,b)implicit nonelogical :: rat_gt_rattype(rational), intent(in) :: a,breal :: fa,fbfa=real(a%num)/real(a%denom)fb=real(b%num)/real(b%denom)if ( fa > fb ) thenrat_gt_rat=.true.elserat_gt_rat=.false.end ifreturnend function rat_gt_ratfunction rat_lt_rat(a,b)implicit nonelogical :: rat_lt_rattype(rational), intent(in) :: a,breal :: fa,fbfa=real(a%num)/real(a%denom)fb=real(b%num)/real(b%denom)if ( fb > fa ) thenrat_lt_rat=.true.elserat_lt_rat=.false.end ifreturnend function rat_lt_ratfunction rat_compare_rat(a,b)implicit nonelogical :: rat_compare_rat type(rational), intent(in) :: a,b type(rational) :: cc=a-bif ( c%num == 0 ) thenrat_compare_rat=.true.elserat_compare_rat=.false. end ifreturnend function rat_compare_ratfunction rat_ne_rat(a,b)implicit nonelogical :: rat_ne_rattype(rational), intent(in) :: a,b type(rational) :: cc=a-bif ( c%num==0 ) thenrat_ne_rat=.false.elserat_ne_rat=.true.end ifreturnend function rat_ne_ratsubroutine rat_eq_rat( rat1, rat2 ) implicit nonetype(rational), intent(out):: rat1 type(rational), intent(in) :: rat2rat1%num = rat2%numrat1%denom = rat2%denomreturnend subroutine rat_eq_ratsubroutine int_eq_rat( int, rat ) implicit noneinteger, intent(out):: inttype(rational), intent(in) :: ratint = rat%num / rat%denomreturnend subroutine int_eq_ratsubroutine real_eq_rat( float, rat )implicit nonereal, intent(out) :: floattype(rational), intent(in) :: ratfloat = real(rat%num) / real(rat%denom)returnend subroutine real_eq_ratfunction reduse( a )implicit nonetype(rational), intent(in) :: ainteger :: btype(rational) :: reduseb=gcv_interface(a%num,a%denom) reduse%num = a%num/breduse%denom = a%denom/breturnend function redusefunction gcv_interface(a,b)implicit noneinteger, intent(in) :: a,binteger :: gcv_interfaceif ( min(a,b) .eq. 0 ) thengcv_interface=1returnend ifif (a==b) thengcv_interface=areturnelse if ( a>b ) thengcv_interface=gcv(a,b)else if ( a<b ) thengcv_interface=gcv(b,a)end ifreturnend function gcv_interfacerecursive function gcv(a,b) result(ans)implicit noneinteger, intent(in) :: a,binteger :: minteger :: ansm=mod(a,b)select case(m)case(0)ans=breturncase(1)ans=1returncase defaultans=gcv(b,m)end selectreturnend function gcvfunction rat__rat_plus_rat( rat1, rat2 )implicit nonetype(rational) :: rat__rat_plus_rattype(rational), intent(in) :: rat1,rat2type(rational) :: actact%denom= rat1%denom * rat2%denomact%num = rat1%num*rat2%denom + rat2%num*rat1%denom rat__rat_plus_rat = reduse(act)returnend function rat__rat_plus_ratfunction rat__rat_minus_rat( rat1, rat2 )implicit nonetype(rational) :: rat__rat_minus_rattype(rational), intent(in) :: rat1, rat2type(rational) :: temptemp%denom = rat1%denom*rat2%denomtemp%num = rat1%num*rat2%denom - rat2%num*rat1%denom rat__rat_minus_rat = reduse( temp )returnend function rat__rat_minus_ratfunction rat__rat_times_rat( rat1, rat2 )implicit nonetype(rational) :: rat__rat_times_rattype(rational), intent(in) :: rat1, rat2type(rational) :: temptemp%denom = rat1%denom* rat2%denomtemp%num = rat1%num * rat2%numrat__rat_times_rat = reduse(temp)returnend function rat__rat_times_ratfunction rat__rat_div_rat( rat1, rat2 )implicit nonetype(rational) :: rat__rat_div_rattype(rational), intent(in) :: rat1, rat2type(rational) :: temptemp%denom = rat1%denom* rat2%numtemp%num = rat1%num * rat2%denomrat__rat_div_rat = reduse(temp)returnend function rat__rat_div_ratsubroutine input(a)implicit nonetype(rational), intent(out) :: awrite(*,*) "分子:"read(*,*) a%numwrite(*,*) "分母:"read(*,*) a%denomreturnend subroutine inputsubroutine output(a)implicit nonetype(rational), intent(in) :: aif ( a%denom/=1 ) thenwrite(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom elsewrite(*, "(I3)" ) a%numend ifreturnend subroutine outputend module rational_utilityprogram mainuse rational_utilityimplicit nonetype(rational) :: a,b,ccall input(a)call input(b)c=a+bwrite(*,*) "a+b="call output(c)c=a-bwrite(*,*) "a-b="call output(c)c=a*bwrite(*,*) "a*b="call output(c)c=a/bwrite(*,*) "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"stopend program main。

fortran课本习题答案

fortran课本习题答案
Fortran课本习题答案
在学习Fortran编程语言的过程中，课本习题答案是非常重要的。

它们不仅可以帮助我们更好地理解和掌握知识，还可以帮助我们提高编程能力和解决问题的
能力。

首先，课本习题答案可以帮助我们检验自己的学习成果。

通过完成课本习题并
对比答案，我们可以了解自己在学习中的掌握程度，发现自己的不足之处，从
而有针对性地进行学习和提高。

其次，课本习题答案还可以帮助我们更好地理解知识点。

在完成习题的过程中，我们可能会遇到一些困难和疑惑，而课本习题答案可以为我们提供参考和解答，帮助我们更好地理解和掌握知识点。

此外，课本习题答案还可以帮助我们提高编程能力。

通过不断地完成习题并对
比答案，我们可以积累更多的编程经验，提高自己的编程能力，同时也可以学
习到一些常见的编程技巧和方法。

总之，课本习题答案对于我们学习Fortran编程语言是非常重要的。

它们不仅可以帮助我们检验学习成果，更可以帮助我们更好地理解知识点，提高编程能力，是我们学习的重要辅助工具。

希望大家能够充分利用课本习题答案，不断提高
自己的编程水平，取得更好的学习成绩。

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°从键盘输入）。

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

Fortran95程序设计习题答案

Fortran95程序设计习题答案第四章 1.program main implicit none write(*,*) "Have a good time." write(*,*) "That's not bad." write(*,*) '"Mary" isn''t my name.' end program 2.program main real, parameter :: PI=3 implicit none.14159real radius write(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积='f8. 3)") radius*radius*PI end program 3.program main implicit none real grades write(*,*) "请输入成绩" read(*,*)grades write(*,"(' 调整后成绩为 'f8.3)") SQRT(grades)*10.0 end program 4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a ! 输出1, 因为使用整数计算, 小数部分会无条件舍去 write(*,*) rb/ra ! 输出1.5 5.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%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 program 2.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 program 3.program main implicit none integer age, money real tax write(*,*) "请输入年龄"write(*,*) "请输入月收入" read(*,*) money if ( age<50 ) thenread(*,*) ageif ( 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 ifwrite(*,"(' 税金为 'I8)") nint(money*tax) end program 4.program main implicit none integer year, days logical mod_4, mod_100, mod_400write(*,*) "请输入年份" 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 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 ) then write(*,*) "猜对了" else write(*,*) "猜错了" end if stop end program4.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 = 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 mainimplicit 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 integerc(3,4,5,6) ! 3*4*5*6=360 integer d(-5:5) ! 11 integer e(-3:3, -3:3) ! 7*7=49 3.program main implicit none integer, parameter :: max=10integer 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 program 4.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-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 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 none real, parameter :: PI=3.14159 real radius, area area = radius*radius*PI return end subroutine 2.program main implicit nonereal 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 returnend function 3.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 subroutine 4.program main implicit none integer, external :: add write(*,*)add(100) end program recursive integer function add(n)integer, intent(in) :: n if ( n<0 ) then sum=0 return elseresult(sum) implicit noneif ( n<=1 ) then sum=n return end if sum = n + add(n-1) return end function 5.program main implicit none integer, external :: gcdwrite(*,*) 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) dowhile( SMALL /= 1 )TEMP=mod(BIG,SMALL) if ( TEMP==0 ) exit BIG=SMALL SMALL=TEMP enddo gcd=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,maxx py = (maxy/2)*sin(x)+maxy/2+1 call PutChar(px,py) x=x+xinc end docall UpdateScreen() stop end program 第九章 1.program main implicitnone character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer count integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filenameinquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") count = 0 dowhile(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) bufferif ( status/=0 ) exit ! 没有资料就跳出循环 write(*,"(A79)") buffercount = count+1 if ( count==24 ) then pause count = 0 end if end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end2.program main implicit none character(len=79) :: filenamecharacter(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 enddo 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 iopen(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%scienceread(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%englishtotal%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) pen(unit=fileid, file=filename, & access="sequential", if ( alive ) then ostatus="old") do while(.true.) read(unit=fileid, fmt="(A79)",iostat=status ) buffer if ( status/=0 ) exit ! 没有数据就跳出循环 doi=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 end 5.module typedef typestudent 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) :: tempstrtype(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)%Englishtotal%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 ntype(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 if end do end do forall(i=1:n) s(i)%rank = i end forall end subroutine 第十章 1.integer(kind=4) ::4 bytes real(kind=4) :: b ! 4 bytes real(kind=8) :: c ! 8 bytes character(len=10) :: a !str ! 10 bytes integer(kind=4), pointer :: pa ! 4 bytesreal(kind=4), pointer :: pb ! 4 bytes real(kind=8), pointer :: pc ! 4 bytes character(len=10), pointer :: pstr ! 4 bytes type studentinteger Chinese, English, Math end type type(student) :: s ! 12 bytes type(student), pointer :: ps ! 4 bytes 2.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=>headnullify(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 ex1016 use linklist implicit nonecharacter(len=20) :: filename character(len=80) :: tempstrtype(datalink), pointer :: head type(datalink), pointer :: ptype(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%itemp=>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 program 4.module typedef implicit none type :: datalink integer :: i type(datalink), pointer :: next end type datalink end module typedef program ex1012 use typedef implicit none type(datalink) , pointer :: p, head, nextinteger :: 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 endif p=>p%next p%i=i end do nullify(p%next) p=>head dowhile(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 stop end program 第十一章 1.moduleutility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r) real, parameter :: PI=3.14159 real rCircleArea = 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 program 2.module time_utility implicit none type :: timeinteger :: hour,minute,second end type time interface operator(+) module procedure add_time_time end interface contains functionadd_time_time( a, b ) implicit none type(time) :: add_time_timetype(time), intent(in) :: a,b integer :: seconds,minutes,carryseconds=a%second+b%second carry=seconds/60minutes=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 functionadd_time_time subroutine input( a ) implicit none type(time),intent(out) :: a write(*,*) " Input hours:" read (*,*) a%hourwrite(*,*) " 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 usetime_utility implicit none type(time) :: a,b,c call input(a) callinput(b) c=a+b call output(c) stop end program main 3.modulerational_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 interfaceoperator(*) module procedure rat__rat_times_rat end interfaceinterface operator(/) module procedure rat__rat_div_rat end interface interface assignment(=) module procedure rat_eq_rat module procedureint_eq_rat module procedure real_eq_rat end interface 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 containsfunction rat_gt_rat(a,b) implicit none logical :: rat_gt_rattype(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_ratfunction rat_lt_rat(a,b) implicit none logical :: rat_lt_rattype(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) implicit nonelogical :: 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 returnend function rat_compare_rat function rat_ne_rat(a,b) implicit none 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_ratsubroutine rat_eq_rat( rat1, rat2 ) implicitnone type(rational), intent(out):: rat1 type(rational),intent(in) :: rat2 rat1%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 subroutinereal_eq_rat( float, rat ) implicit none real, intent(out) :: floattype(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 :: btype(rational) :: reduse b=gcv_interface(a%num,a%denom) reduse%num =a%num/b reduse%denom = a%denom/b return end function reduse functiongcv_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 ) thengcv_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 returncase(1) ans=1 return 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,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, rat2type(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_ratfunction rat__rat_times_rat( rat1, rat2 ) implicit nonetype(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_rattype(rational), intent(in) :: rat1, rat2 type(rational) :: temptemp%denom = rat1%denom* rat2%num temp%num = rat1%num * rat2%denomrat__rat_div_rat = reduse(temp) return end function rat__rat_div_rat subroutine input(a) implicit none type(rational), intent(out) :: awrite(*,*) "分子:" 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-bwrite(*,*) "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 main 4.module vector_utility implicit none type vector real x,y end type interface operator(+) module procedurevector_add_vector end interface interface operator(-) module procedurevector_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) functionvector_add_vector(a,b) type(vector), intent(in) :: a,bvector_add_vector = vector(a%x+b%x, a%y+b%y) end function type(vector) functionvector_sub_vector(a,b) type(vector), intent(in) :: a,bvector_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) functionvector_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,bvector_dot_vector = a%x*b%x + a%y*b%y end function subroutineoutput(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。

Fortran95第一章第六大题习题与答案

1. 从键盘输入a,b,c 的值，计算f=cos ｜a+b ｜/sin ｜b｜｜a｜++tan c 上机执行该程序，输入a=-4.6°,b=10°,c=21.85°,观察计算结果。

计算公式为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 。

fortran课后习题答案

fortran课后习题答案Fortran课后习题答案在学习Fortran编程语言时，课后习题是巩固知识、提高编程能力的重要途径。

通过解答课后习题，学生可以加深对Fortran语法和逻辑的理解，提高编程实践能力。

以下是一些Fortran课后习题答案，供大家参考。

1. 编写一个Fortran程序，计算并输出1到100的所有偶数的和。

程序代码如下：```fortranprogram sum_even_numbersimplicit noneinteger :: i, sumsum = 0do i = 2, 100, 2sum = sum + iend doprint *, 'The sum of even numbers from 1 to 100 is:', sumend program sum_even_numbers```2. 编写一个Fortran程序，找出一个整数数组中的最大值和最小值，并输出它们的位置。

程序代码如下：```fortranprogram find_max_minimplicit noneinteger :: i, n, max_val, min_val, max_pos, min_pos integer, dimension(10) :: arr! 初始化数组arr = (/3, 7, 2, 8, 5, 10, 1, 6, 4, 9/)! 初始化最大值和最小值max_val = arr(1)min_val = arr(1)max_pos = 1min_pos = 1! 找出最大值和最小值do i = 2, 10if (arr(i) > max_val) thenmax_val = arr(i)max_pos = iendifif (arr(i) < min_val) thenmin_val = arr(i)min_pos = iendifend doprint *, 'The maximum value is', max_val, 'at position', max_posprint *, 'The minimum value is', min_val, 'at position', min_posend program find_max_min```通过这些课后习题的答案，我们可以看到Fortran语言的一些基本特性和常用语法的运用。

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.输入一个学生的学号和三门课程的成绩。

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

第一章 FORTRAN程序设计基础第15页 1、21．简述程序设计的步骤。

“程序设计”：反映了利用计算机解决问题的全过程，通常要经过以下四个基本步骤：(1)分析问题，确定数学模型或方法；(2)设计算法，画出流程图；(3)选择编程工具，编写程序；(4)调试程序，分析输出结果。

2. 什么是算法？它有何特征？如何描述算法？解决问题的方法和步骤称为算法。

算法的五个特征：(1) 有穷性。

(2) 确定性。

(3) 有效性。

(4) 要有数据输入。

(5) 要有结果输出。

算法的描述有许多方法，常用的有：自然语言、一般流程图、N－S图等。

第二章顺序结构程序设计第29页 1、2、3、4、5、6、7、8、91．简述符号常量与变量的区别？符号常量在程序运行过程中其值不能改变。

变量在程序运行过程中其值可以改变。

2. 下列符号中为合法的FORTRAN 90标识符的有哪些?(1) A123B (2) M%10 (3) X_C2 (4) 5YZ(5) X+Y (6) F(X) (7) COS(X) (8) A.2(9) ‘A’ONE (10) U.S.S.R.(11) min*2 (12) PRINT3. 下列数据中哪一些是合法的FORTRAN常量？(1) 9,87 (2) .0 (3) 25.82(4) -356231(5) 3.57*E2 (6) 3.57E2.1 (7) 3.57E+2(8) 3,57E-24. 已知A=2,B=3,C=5(REAL)；且I=2,J=3(INTEGER),求下列表达式的值:(1) A*B+C 表达式的值: 11 (2) A*(B+C) 表达式的值: 16(3) B/C*A 表达式的值: 1.2 (4) B/(C*A) 表达式的值: 0.3(5) A/I/J 表达式的值: 0.33 (6) I/J/A 表达式的值: 0(7) A*B**I/A**J*2 表达式的值: 4.5(8) C+(B/A)**3/B*2. 表达式的值: 7.25(9) A**B**I 表达式的值: 5125. 将下列数学表达式写成相应的FORTRAN表达式：(1) 1E-2 （2）(-B+SQRT(B*B-4*A*C)/(2*A)(3) 1+X+X*X/2+X**3/2/3(4) COS(ATAN((A**3+B**3)**(1.0/3)/(C*C+1)))(5) EXP(A*X**2+B*X+C)(6) COS(X*Y/SQRT(X*X+Y*Y))**36. 用FORTRAN语句完成下列操作：(1) 将变量I的值增加1。

I=I+1(2) I的立方加上J,并将结果保存到I中。

I=I**3+J(3) 将E和F中大者存储到G中。

G=Max(E,F)(4) 将两位自然数N的个位与十位互换，得到一个新的数存储到M中(不考虑个位为0的情况)M=MOD(N,10)*10+N/10第三章选择结构程序设计第43页 1、2、3、5、6、7、91．分析下列程序运行结果(1)LOGICAL PINTEGER I,I1,I2,I3P=.FALSE.READ*,II1=MOD(I,10)I2=MOD(I/10,10)I3=I/100IF(I1+I3.EQ.2*I2)P=.TRUE.PRINT*,PEND输入123 时，输出： T输入132 时，输出： F(2)REAL X,Y,ZREAD*,X,YIF((X*Y)>0.AND.(X.NE.1.0))THENZ=10.0ELSE IF(X*Y<0.0) THENZ=0.0ELSEZ=-1.0ENDIFWRITE(*,*)ZEND输入1,4 ，输出： -1.0输入4,1 ，输出： 10.0输入1,-4 ，输出： 0.0(3)INTEGER X,Y,A,BX=1Y=0A=3B=4SELECT CASE(X)CASE(1)SELECT CASE(Y)CASE(0)A=A+1CASE(1)B=B+ 1END SELECTCASE(2)A=A+1B=B-1CASE DEFAULTA=A+BB=A+BEND SELECTPRINT*,"A=",A,"B=",BEND输出结果是：A=4 B=42．将下列数学运算转换成对应的FORTRAN表达式或写出语句。

(1) x∈(3,6) FORTRAN表达式: x>0.AND.x<6(2) 2.5≤y≤8 FORTRAN表达式: y>=2.5.AND.y<=8(3) x+y≠z+6 FORTRAN表达式: (x+y)/=(z+6)(4) 2x+4y+xy=0 FORTRAN表达式: 2*x+4*y+x*y=0(5) |a-b|≤c2FORTRAN表达式: ABS(a-b)<=c*c(6) 如果x<y或x<z，则min=xFORTRAN语句: IF(x<y.OR.x<z)min=x(7) 实数a,b,c能否构成三角形三边FORTRAN表达式: a>0.AND.b>0.AND.c>0.AND.(a+b)>c.AND.(b+c)>a.AND.(c+a)>b(8) a,b 之一为0但不同时为0FORTRAN表达式: (a==0.OR.b==0).AND.(.NOT.(a==0.AND.b==0))(9) 如果m与n相等,则k为1,否则k为0FORTRAN语句:IF(m==n)THENk=1ELSEk=0ENDIF(10) a,b是否相同号FORTRAN表达式: a*b>03.如果A=2.5,B=7.5,C=5.0,D=6.0,L=.TRUE.,M=.FALSE.,请求出下列逻辑表达式的值。

(1) (A+B).LT.(C+D).AND.A.EQ.3.5 逻辑表达式的值: .FALSE.(2) A+B/2.0.NE.C-D.OR.C.NE.D 逻辑表达式的值: .TRUE.(3) .NOT.L.OR.C.EQ.D.AND.M 逻辑表达式的值: .FALSE.(4) C/2.0+D.LT.A.AND..NOT..TRUE..OR.C.EQ.D 逻辑表达式的值: .FALSE.(5) (C.GT.D).OR.C.NOT.(A+B.LT.D) 该表达式错误(6) (A.LT.B).AND.(B.LT.A) 逻辑表达式的值: .FALSE.5、某运输公司在计算运费时，按照运输距离S对运费打一定的折扣D，其标准如下：S<250km D=0250≤S<500km D=2.5%500≤S<1000km D=4.5%1000≤S<2000km D=7.5%2000≤S<2500km D=9.0%2500≤S<3000km D=12.0%3000km≤S D=15.0%编写程序，输入基本运费Price，货物重量Weight，距离S，计算总运费Freight。

其中Freight=Price*Weight*S*(1-D)。

REAL Price, Weight, S, Freight, DREAD*, Price, Weight, SIF (S<250) THEND=0ELSEIF(S<500) THEND=0.025ELSEIF(S<1000) THEND=0.045ELSEIF(S<2000) THEND=0.075ELSEIF(S<2500) THEND=0.09ELSEIF(S<3000) THEND=0.12ELSED=0.15ENDIFFreight=Price*Weight*S*(1-D)WRITE(*,*)"Freight=", FreightEND6、编程判断自然数M 是否为N 的因子，是输出YES, 不是输出NO 。

INTEGER M,NREAD(*,*)M,NIF(MOD(N,M)= =0) THENWRITE(*,*)"YES"ELSEWRITE(*,*)"NO"ENDIFEND7、编程判断两位整数M 是否为守形数。

所谓守形数是指该数本身等于自身平方的低位数，如25是守形数，因为252=625，而625的低两位为25。

是输出YES, 不是输出NO 。

INTEGER MREAD(*,*)MIF(MOD(M*M,100)==M)THENWRITE(*,*)"YES"ELSEWRITE(*,*)"NO"ENDIFEND9 已知⎪⎪⎩⎪⎪⎨⎧<<<≤+<<-+=其他2322015100)1ln(015)1cos(x x x x x x x y 从键盘输入x ，求出y 的值。

REAL X,YREAD(*,*)XIF(X>-15.AND.X<0)THENY=COS(X+1)ELSEIF(X>=0.AND.X<10)THENY=LOG(X*X+1)ELSEIF(X>15.AND.X<20)THENY=X**(1.0/3)ELSEY=X*XENDIFWRITE(*,*)"Y=",YEND第四章循环结构程序设计第64页 1、2、5、11、12 1.写出下列程序的执行结果(1) 1.0(2) 8 11(3) k= 6(4) 14 5(5) 5167P.65 2. 利用下式计算π的近似值。

)1000(14134171513114=---++-+-=n n n πIMPLICIT NONEREAL PIINTEGER IPI=0DO I=1,NPI=PI+1.0/(4*I-3)-1.0/(4*I-1)END DOPRINT*,PI*4ENDP66 习题5IMPLICIT NONEINTEGER N,S,M,ILOGICAL FLAGDO N=3,999,2FLAG=.TRUE.M=SQRT(REAL(N))DO I=2,MIF(MOD(N,I)==0)THENFLAG=.FALSE.EXITENDIFENDDOIF(FLAG) THENS=N/100+MOD(N/10,10)+MOD(N,10)IF(MOD(S,2)/=0)PRINT*,NENDIFEND DOENDP.66 习题11REAL Y0,Y1READ(*,*)XY0=XY1=2*Y0/3+X/(3*Y0**2)DO WHILE(ABS(Y1-Y0)>1E-5)Y0=Y1Y1=2*Y0/3+X/(3*Y0**2)ENDDOPRINT*,Y1ENDP.66 习题12Real a,b,m,xf(x)=x**3-x**2-1Read*,a,bDo while(Abs(a-b)>1e-6)m=(a+b)/2If(f(a)*f(m)>0)thena=mElseb=mEndifEnddoPrint*,(a+b)/2END第五章 FORTRAN 90数据类型第88页 4、104．有一个三角形，顶点为X,Y,Z，其坐标分别为(1.5,2.0),(4.5,4.5),(18.0,10.5)。