内容发布更新时间 : 2025/2/2 4:39:50星期一 下面是文章的全部内容请认真阅读。

第四章

1.program main implicit none write(*,*) \a good time.\ write(*,*) \not bad.\ write(*,*) '\

2.program main real, parameter :: PI=3 implicit none.14159 real 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)\

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'英寸')\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(*,*) \请输入年龄\ 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)\ end program

4.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'天')\ stop end program

第六章

1.program main implicit none integer i do i=1,5 write(*,*) \ end do stop end program

2.program main implicit none integer i,sum sum = 0 do i=1,99,2 sum = sum+i end do write(*,*) sum stop end program

3.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 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 = item/real(i) ans = ans+item

end do write(*,*) ans stop end program

5.program main implicit none integer, parameter :: length = 79 character(len=length) :: input, output integer i,j write(*,*) \请输入一个字串\ read(*,\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(*,\ 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 program

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=49

3.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(*,\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(*,\a stop end 5.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)\ 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 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 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(*,\ return end subroutine

4.program main implicit none integer, external :: add write(*,*) add(100) end program recursive integer function add(n) result(sum) implicit none integer, intent(in) :: n if ( n<0 ) then sum=0 return else if ( n<=1 ) then sum=n return end if sum = n + add(n-1) return end function

5.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 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 implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer count integer :: status = 0 logical alive write(*,*) \ read (*,\filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access=\status=\

count = 0 do while(.true.) read(unit=fileid, fmt=\iostat=status ) buffer if ( status/=0 ) exit ! 没有资料就跳出循环 write(*,\ count = count+1 if ( count==24 ) then pause count = 0 end if end do else write(*,*) TRIM(filename),\ end if stop end

2.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer i integer :: status = 0 logical alive write(*,*) \ read (*,\ inquire( file=filename, exist=alive) if

( alive ) then open(unit=fileid, file=filename, & access=\status=\ do while(.true.) read(unit=fileid, fmt=\ if ( status/=0 ) exit ! 没有资料就跳出循环 do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-3 ) end do write(*,\buffer end do else write(*,*) TRIM(filename),\ 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=\ write(*,\\座号\中文\英文\数学\自然\社会\总分\ 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(*,\ end do write(*,\平均\ 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(*,*) \ read (*,\ inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access=\status=\ do while(.true.) read(unit=fileid, fmt=\ 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(*,\buffer end do else write(*,*) TRIM(filename),\ stop end

5.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=\iostat=error) if ( error/=0 ) then write(*,*) \grades.txt fail.\ stop end if read(fileid, \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(*,\座号\中文\英文\数学\自然\社会\总分\名次\ do i=1,students write(*,\s(i) end do ! 计算并输出平圴分数 write(*,\\平均\& 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 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 ! 5

3.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(*,*) \ read(*,*) filename open(10, file=filename, status=\iostat=error) if ( error/=0 ) then write(*,*) \file fail!\ stop end if allocate(head) nullify(head%next) p=>head size=0 read(10, \读入第一行字符串, 不需要处理它 ! 读入每一位学生的成绩 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(*,*) \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(*,\\中文\ \英文

\ \数学\ \自然\ \社会\ 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, 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(*, \) 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 program

2.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(*,*) \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(*, \hours',I3,' minutes',I3,' seconds')\ 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 main

3.module rational_utility implicit none private public :: rational, & operator(+), operator(-), operator(*),& operator(/), assignment(=),operator(>),& operator(<), operator(==), operator(/=),& output, input type :: rational integer :: num, denom end type rational interface operator(+) module procedure rat__rat_plus_rat end interface interface operator(-) module procedure rat__rat_minus_rat end interface interface operator(*) module procedure rat__rat_times_rat end interface interface operator(/) module procedure