Fortran上机作业(五)
Fortran95程序设计课后习题答案(word版方便)
第四章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 = 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+itemend 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-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 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.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 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=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 callPutChar(px,py) x=x+xinc end 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 end if end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end2.p rogram 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)," 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 end4.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 if end 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 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(*,*) "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 stop end program4.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, 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 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 procedurerat__rat_div_rat end interface interface assignment(=) module procedure rat_eq_rat module procedure int_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 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):: 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 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) 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=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 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, 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 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期末复习资料-Fortran程序设计_05
20XX年复习资料大学复习资料专业：班级：科目老师：日期：一、选择题（每题2分，共30分）1. 下列数据中，不符合FORTRAN 90常量表示法的是__________。
A. -23.4B. 2.758D+3C. (3, 4)D. TRUE2. 数学表达式()()27log t b a e t -•+•在FORTRAN 中的正确的表达式为__________。
A. E**T*LOG*(A+B)*(-7*SQR(T))B. EXP(T)*LOG20XXXX(A+B)*(-7*T**2)C. EXP(T)*LN(A+B)*(-7*SQR(T))D. E**T*LOG(A*B)*(-7*T**2)3. 下列名称中，符合FORTRAN90/95命名规则的是__________。
A. a3_bB. “Pi ”C. 2XYD. .false.4. 下列循环语句执行后，输出k 的值分别是__________。
DO K=2，20XXXX ，4IF(MOD(K,20XXXX)= =0) WRITE(*,*) K+1WRITE(*,*) KEND DOWRITE(*,*) KA. 2 6 20XXXX 20XXXX 20XXXXB. 2 6 20XXXX 20XXXX 20XXXXC. 2 6 20XXXX 20XXXX 20XXXXD. 2 6 20XXXX 20XXXX 20XXXX 20XXXX5. 阅读下列程序PROGRAM AREAD(*,20XXXX0)X,Y20XXXX0 FORMAT(1X,2F3.1)S=MOD(Y,X)WRITE(*,200)S20XX0 FORMAT(F3.1)END在执行上述程序后，由键盘输入20XXXX3446889，最后输出的S 值为__________。
A. 0.0B. 8.1C. 21.0D. 1.06. 判别英语成绩E 和FORTRAN 成绩F 都必须大于60分的正确的表达式是__________。
Fortran第5章
注意：不能出现大数， Do n=1,100 否则将超出范围 如 A=A*N A=A*x/n s=s+x**n/A S=s+A 分母为大数，有时会死循环、 输出NaN等等难以预测情况。 enddo 第84页例5-6：N=30时结果为 Print*, s, exp(x) 负数 end
练习：求
s cos x 1 (1)
3
10 6 …… 错误的输入格式： 2，8，3，10，6，……
S=S+X
ENDDO PRINT'("S=",I6)',S END PROGRAM EXAM4
2．A=A*表达式
例：求
s e 1 x
x
重复：
x2 2!
x3 3!
x1 0 0 100!
s s
xn n!
分析通项A的求法：an=an-1*x/n 即A=A*X/n, n=1,2,……100
同构数
例5-26 （102页）编程，输出1000以内的所有同构数。 所谓同构数是指一个数位于它的平方数的最右端。如5的平 方数是25，25的平方数是625，，所以5，25都是同构数。 Do I=1,1000 判定I是否为同构数 enddo 同构数分析： （1）1000以内的所有同构数，分三类：可能 是一位数、两位数、三位数（三分支结构）。 （2）先求平方数，再取最右端的一位数、两位数、三 位数，后判断
有循环变量DO结构的一般形式 表示：do n=1,100,1 nn: Do n=1,100,1 a= 2*n s=s+a
a= 2*n
s=s+a enddo
enddo nn
有循环变量DO结构的一般形式 [DO结构名]： DO, 循环变量I=初值e1，终值e2，步长值e3 循环体 END DO [DO结构名]
fortran考试题及答案
fortran考试题及答案1. 以下哪个选项是Fortran语言中合法的变量名？A. 2variableB. variable2C. _variable2D. variable-2答案：C. _variable22. Fortran程序中，以下哪个语句用于定义一个整型数组？A. INTEGER :: array(10)B. REAL :: array(10)C. INTEGER :: array[10]D. REAL :: array[10]答案：A. INTEGER :: array(10)3. 在Fortran中，以下哪个是正确的循环结构？A. DO i = 1, 10B. FOR i = 1 TO 10C. DO i = 1 TO 10D. FOR i = 1, 10答案：A. DO i = 1, 104. Fortran中，以下哪个函数用于计算数组的平均值？A. SUMB. AVERAGEC. MEAND. AVG答案：C. MEAN5. 在Fortran程序中，以下哪个语句用于打开一个文件？A. OPEN(unit=1, file='example.txt')B. CREATE(unit=1, file='example.txt')C. READ(unit=1, file='example.txt')D. WRITE(unit=1, file='example.txt')答案：A. OPEN(unit=1, file='example.txt')6. Fortran中，以下哪个语句用于声明一个双精度实数变量？A. REAL :: xB. DOUBLE PRECISION :: xC. INTEGER :: xD. LOGICAL :: x答案：B. DOUBLE PRECISION :: x7. 在Fortran中，以下哪个是正确的条件语句？A. IF x > 0 THENB. IF (x > 0) THENC. IF x > 0 THEND. IF x > 0 THEN答案：B. IF (x > 0) THEN8. Fortran程序中，以下哪个是正确的子程序声明？A. SUBROUTINE mySubroutineB. FUNCTION myFunctionC. MODULE myModuleD. PROGRAM myProgram答案：A. SUBROUTINE mySubroutine9. 在Fortran中，以下哪个语句用于读取一个整数？A. READ(*,*) iB. PRINT(*,*) iC. WRITE(*,*) iD. FORMAT(*,*) i答案：A. READ(*,*) i10. Fortran中，以下哪个是正确的模块声明？A. MODULE myModuleB. SUBROUTINE myModuleC. FUNCTION myModuleD. PROGRAM myModule答案：A. MODULE myModule。
二级FORTRAN程序设计上机题集
二级FORTRAN程序设计上机题集上机题1======================================================================试题说明 :======================================================================补充编制fortran77程序prog1.for，其功能是计算并输出级数和1 1 (-1)^ns(n)=x - ─x^3 + ─x^5 - ... + ── x^(2n+1)3 5 2n+1直到s(n)-s(n-1)＜0.000001为止。
其中x＝0.7。
请编写该程序，最后运行程序。
其中部分程序与输出子程序writedat在程序中已经给出，不得修改。
======================================================================程序 :======================================================================write(*,100) s100 format(1x,'s=',e12.4)write(*,*)call writedat(s)endsubroutine writedat(s)open(10,file='bc01.out',status='new')write(10,100) s100 format(1x,e12.4)end======================================================================所需数据 :======================================================================@3 $bc01.out 001|.6107e+00#e上机题2=============================================================================== 试题说明 :补充编制fortran77程序prog1.for，其功能是计算并输出级数和1 1 1s(n)=1 + x + ─x^2 + ─x^3 +... + ─x^n2! 3! n!直到s(n)-s(n-1)＜0.000001为止。
fortran 第5章
!变量<=5时，会执行这个case中的程序模块
!变量＝1或3或5时，会执行这个case中的程序模块
§ 5-3 SELECT CASE 语句
例：
A=65 Read(*, *) key Select case(key) Case(a) !这一行程序错，A为变量 …… Case(c) ! 如果c声明成parameter 的常量，才可 ……
§5-2-2 字符的逻辑判断
根据保存它们的字符码，比较字符的大小 （个人计算机都是用ASCII码）
注意字符要以引号封装
§ 5-3 SELECT CASE 语句
SELECT CASE 语句可以取代某些使 用IF-ELSE IF的语句 使程序更加简洁
结构如下：
放入所要判 断的变量
不一定出现
§ 5-3 SELECT CASE 语句
§5-1-2 逻辑运算
【.NEQV.】
逻辑A TRUE TRUE FALSEUE FALSE
A .NEQV. B FALSE TRUE TRUE FALSE
(1>3 .NEQV. 2>3) !两边都不成立，表达式为假 (1>3 .NEQV. 2<3) !两边结果不同，表达式为真
$ 5-1-3 多重判断 IF
• 执行效率较高
ELSE IF
$ 5-1-4 嵌套IF语句
只有第一层的IF成立， 才可能执行第二层的IF的 判断，及第二层中的命令。 层层推进及退出
例：
§5-2 浮点数及字符的逻辑运算
§ 5-2-1 浮点数 浮点数要避免使用“==“的判断 例：
浮点数的计算误差经常存在，要预留空间 改为：
A>=0.0 .AND. A+C> B+D .OR. .NOT. .TRUE.
fortran考试题及答案分开
fortran考试题及答案分开1. 以下哪个选项是Fortran语言中正确的整型变量声明？A. INTEGER xB. REAL xC. COMPLEX xD. LOGICAL x答案：A2. Fortran程序中，哪个关键字用于定义数组？A. ARRAYB. LISTC. VECTORD. DIMENSION答案：D3. 在Fortran中，以下哪个选项是正确的条件语句？A. IF (x > 0) THENPRINT *, 'x is positive'B. IF x > 0 THENPRINT *, 'x is positive'C. IF (x > 0)PRINT *, 'x is positive'D. IF x > 0PRINT *, 'x is positive'答案：A4. Fortran中用于循环结构的关键字是什么？A. LOOPB. ITERATEC. DOD. FOR答案：C5. 如何在Fortran程序中包含另一个文件？A. 使用INCLUDE语句B. 使用IMPORT语句C. 使用INCLUDE关键字D. 使用IMPORT关键字答案：A6. Fortran中，哪个函数用于计算数组元素的总和？A. SUMB. TOTALC. AGGREGATED. ACCUMULATE答案：A7. 在Fortran中，如何声明一个具有默认值的变量？A. INTEGER :: x = 0B. INTEGER x = 0C. INTEGER x DEFAULT 0D. INTEGER x = DEFAULT 0答案：A8. Fortran程序中的主程序必须以哪个关键字开始？A. PROGRAMB. MAINC. PROCEDURED. FUNCTION答案：A9. 在Fortran中，如何声明一个二维数组？A. INTEGER :: matrix(10, 10)B. INTEGER :: matrix[10][10]C. INTEGER :: matrix(10)(10)D. INTEGER :: matrix(10,10)答案：A10. Fortran中用于计算数组元素平均值的函数是什么？A. AVGB. MEANC. AVERAGED. SUM答案：C。
FORTRAN上机实验报告(文件)
大气科学学院FORTRAN程序设计实验报告（2015）有格式文件：有格式文件包括数据本身和记录间的分隔信息，文件中的数据以字符形式（ASCII码）存放记录由一个个的字符组成，每个字符对应一个字节。
有格式文件由格式记录组成，记录的长度与指定的格式有关。
有格式文件的每一记录后用回车符和换行符作为结束标志，可以用文本编辑器直接打开查看内容，所有内部文件都是有格式文件。
FORM= FORMATTED无格式文件：无格式文件包括数据本身和记录间的分隔信息，文件中以二进制式存放数据。
输入输出无需转化，直接高效。
无格式文件的记录间用回车符和换行符作为分隔标志。
FORM= UNFORMATTED二进制文件：二进制文件仅包含数据本身，记录间无分隔信息，结构最紧凑，适合于保存大容量数据的文件。
FORM= BINARY占用空间：有格式〉无格式〉二进制无格式与二进制便于输入输出，但不便供人阅读。
对二进制文件和无格式文件输入输出无需格式控制。
顺序存取：文件中所有记录按存取的先后顺序排列，执行读写操作时，只能从头到尾顺序依次进行。
不能用一个读写语句随意指定要读取的某条记录。
ACCESS=SEQUENTIAL直接存取：文件中所有记录都以自然数进行编号（记录号）且每条记录都有相同长度，读写时可以根据程序需要直接对某条指定的记录进行操作。
ACCESS=DIRECT题目一PROGRAM llREAL,DIMENSION(100):: NUM,QINTEGER M,NREAL IOPEN(10,FILE="RND.TXT")OPEN(12,FILE="RAA.TXT")READ(10,'(F7.2)') NUM！READ（10，*）NUMPRINT '(5F7.2)',NUM !输出读入数据DO M=1,99DO N=M+1,100IF(NUM(M).GT.NUM(N))THEN !比较大小I=NUM(M)NUM(M)=NUM(N)NUM(N)=IEND IFEND DOEND DOWRITE(12,'(5F7.2)') NUM !写入文件12CLOSE(10)CLOSE(12)END题目二PROGRAM KKINTEGER :: I,N=0 REAL :: SUM=0,WATER INTEGER NAMECHARACTER(21) NUMOPEN(10,FILE="05070408.000")OPEN(11,FILE="R05070408.txt")OPEN(12,FILE="HR.txt")PRINT *,'站号：降水量'DO I=1,14READ(10,*) !去除文件头END DODO WHILE(.NOT.EOF(10))READ(10,'(I5,A22,F6.2)') NAME,NUM,WATERWRITE(11,'(I5,A22,F6.2)') NAME,NUM,WATER !写入文件11 IF(WATER.GT.50)THEN !比较〉50降水量WRITE(12,'(I5,3X,F6.2)') NAME,WATER !写入文件12WRITE(*,'(I5,3X,F6.2)')NAME,WATER !屏幕输出符合条件的站N=N+1SUM=SUM+WATEREND IFEND DOPRINT *,'平均降水量'PRINT *,SUM/NCLOSE(10)CLOSE(11)CLOSE(12)END。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
工程分析程序设计 上机作业（五）
数组（1）
上机目的：练习数组的声明、存储、操作，以及数组参数、动态数组、数组函数的使用。
1、 打印杨辉三角形（格式不限）。
1
1 1
1 2 1
1 3 3 1
1 4 6 4 1
program yanghui_triangle
implicit none
real::T(5,5) !第一个数代表列，第二个代表行
integer i,j
Do j=1,5
T(1,j)=1
T(j,j)=1
end Do
DO j=3,5
DO i=2,j
T(i,j)=T(i-1,j-1)+T(i,j-1)
end Do
end Do
print*,T
end program
2、 输入两个矩阵，并用矩阵作为子程序的参数，用子程序完成任意两个矩阵的乘法。（如
果可能，用数组函数子程序来完成这一功能）
program array
integer,parameter::m=2,n=2 !只需要改变常量的大小即可改变数组形状
real A(m,n),B(m,n),C(m,n)
read*,A,B
call ar(A,B,m,n,C)
print*,C
end program
subroutine ar(A,B,m,n,C)
integer m,n
real A(m,n),B(m,n),C(m,n)
C=A*B
end subroutine
3、 用“冒泡算法”对一个数列A(I)进行从小到大排序，步骤如下：（1）若A(2)
从小到大排列。（因为这种算法的特点是，每个元素总是和比它大的数交换位置，小的
元素不断“上浮”，象水中的气泡不断上浮一样，所以称之为“冒泡算法”）
program maopao
implicit none
integer ,parameter::I=10
integer J,k
real A(I),temp
print*,'input',I,' numbers'
read*,A
DO j=1,I-1
DO k=1,I-j
if ( A(k)>A(k+1) ) then
temp=A(k)
A(k)=A(k+1)
A(k+1)=temp
end if
end do
end DO
print*,A
end program
4、 从A、B两个数列中，把同时出现在两个数列中的数据删去。例如：
A：2 5 5 8 9 12 18
B：5 8 12 12 14
操作完成后：
A：2 9 18
B：14
program delete_num
implicit none
real,allocatable::A(:),B(:),C(:),D(:)!尝试用动态数组将比较后的数组分别存入C，D
integer ::i,j,m,n,x=1,y=1
print*,'分别输入两个数组中元素个数m,n'
read*,m,n
allocate(A(m))
allocate(C(m))
allocate(B(n))
allocate(D(n))
print*,'输入数组A'
read*,A
print*,'输入数组B'
read*,B
DO i=1,m
Do j=1,n
if (A(i)==B(j)) exit
if (j==n.and.A(i)/=B(j)) then
C(x)=A(i)
x=x+1
endif
end do
enddo
DO i=1,n
Do j=1,m
if (B(i)==A(j)) exit
if (j==m.and.B(i)/=A(j))then
D(y)=B(i)
y=y+1
endif
enddo
enddo
write(*,'("输出两变化后的数组:")',advance='yes')
write(*,'("A:")',advance='no')
DO i=1,x-1
if (i/=x-1)then
write(*,'(f10.2)',advance='no') C(i)
else
write(*,'(f10.2)',advance='yes') C(i)
endif
enddo
write(*,'("B:")',advance='no')
DO i=1,y-1
if (i/=y-1)then
write(*,'(f10.2)',advance='no') D(i)
else
write(*,'(f10.2)',advance='yes') D(i)
endif
enddo
end program