Fortran95习题答案

合集下载

fortran95期末考试题及答案

fortran95期末考试题及答案FORTRAN95期末考试题及答案一、选择题（每题2分，共20分）1. 下列哪个是FORTRAN95中的合法变量名？A. 123abcB. _123abcC. 123D. variable-name答案：B2. 在FORTRAN95中，以下哪个语句用于定义数组？A. DIMENSIONB. DEFINEC. ARRAYD. DECLARE答案：A3. 下列哪个是FORTRAN95中的内建数据类型？A. INTEGERB. FLOATC. DOUBLED. STRING答案：A4. 在FORTRAN95中，以下哪个语句用于实现循环？A. IFB. DOC. THEND. ELSE答案：B5. 在FORTRAN95中，以下哪个语句用于条件判断？A. IFB. DOC. SELECTD. CASE答案：A6. 下列哪个是FORTRAN95中的文件打开语句？A. OPENB. CLOSEC. READD. WRITE答案：A7. 在FORTRAN95中，以下哪个语句用于实现模块化编程？A. MODULEB. FUNCTIONC. SUBROUTINED. PROGRAM答案：A8. 下列哪个是FORTRAN95中的参数传递方式？A. PASS BY VALUEB. PASS BY REFERENCEC. BOTH A AND BD. NEITHER A NOR B答案：C9. 在FORTRAN95中，以下哪个语句用于定义常量？A. DEFINEB. CONSTANTC. PARAMETERD. EQUIVALENCE答案：C10. 下列哪个是FORTRAN95中的文件关闭语句？A. OPENB. CLOSEC. READD. WRITE答案：B二、简答题（每题5分，共30分）1. 简述FORTRAN95中模块化编程的优点。

答案：模块化编程允许程序被分解成独立的模块，每个模块可以独立编译和测试，提高了代码的可读性和可维护性。

fortran95第七章例题程序

0701一维数组program mainimplicit noneinteger,parameter::students=5integer::student(students)integer i!录入学生成绩do i=1,studentswrite(*,"('number',I2)")iread(*,*)student(i)end do!提取学生成绩，并规定读取范围do while(.true.)write(*,*)"Query"read(*,*)iif(i<=0 .or. i>students) exitwrite(*,*)student(i)end dostopend0702program mainimplicit noneinteger::student1,student2,student3,student4,student5 integer i!录入数据write(*,*)'number1'read(*,*)student1write(*,*)'number2'read(*,*)student2write(*,*)'number3'read(*,*)student3write(*,*)'number4'read(*,*)student4write(*,*)'number5'read(*,*)student5!提取数据do while(.true.)write(*,*)'Query'read(*,*)iselect case(i)case(1)write(*,*)student1case(2)write(*,*)student2case(3)write(*,*)student3case(4)write(*,*)student4case(5)write(*,*)student5case defaultexitend selectend dostopend0703二维数组program mainimplicit noneinteger,parameter::classes=5integer,parameter::students=5 integer::student(students,classes)integer sinteger cdo c=1,classesdo s=1,studentswrite(*,"('Number',I2,'of class',I2)")s,c read(*,*)student(s,c)end doend dodo while(.true.)write(*,*)'class:'read(*,*)cif (c<=0 .or. c>classes) exitwrite(*,*)'student:'read(*,*)sif(s<=0 .or. s>students) exitwrite(*,"('score',I3)")student(s,c)end dostopend!s,c不能超过声明大小，否则程序会出错0704program mainimplicit noneinteger,parameter::row=2integer,parameter::col=2integer::matrixA(row,col)integer::matrixB(row,col)integer::matrixC(row,col)integer rinteger c!读入A矩阵的内容write(*,*)'Matrix A'do r=1,rowdo c=1,colwrite(*,"('A(',I1,',',I1,')=')")r,cwrite(*,*)'Matrix B'do r=1,rowdo c=1,colwrite(*,"('B(',I1,',',I1,')=')")r,cread(*,*)matrixB(r,c) !录入，记录数据end doend do!A+Bwrite(*,*)'Matrix A+B='do r=1,rowdo c=1,colmatrixC(r,c)=matrixA(r,c)+matrixB(r,c) write(*,"('(',I1,',',I1,')=',I3)")r,c,matrixC(r,c) end doend dostopend0705program ex0705implicit noneinteger, parameter :: row = 2integer, parameter :: col = 2integer :: matrix(row, col, 3)integer minteger rinteger cdo m=1, 2write(*,"('Matrix ',I1)") mdo r=1, rowdo c=1, colwrite(*,"('(',I1,',',I1,')=')") r,cread(*,*) matrix(r,c,m)end doend doend dowrite(*,*) "Matrix 1 + Matrix 2 = "do r=1, rowdo c=1, colmatrix(r,c,3) = matrix(r,c,1)+matrix(r,c,2)write(*,"('(',I1,',',I1,')=',I3)") r,c,matrix(r,c,3) end doend dostopend0706program mainimplicit noneinteger,parameter::students=5integer::student(students)=(/80,90,85,75,95/) integer ido while(.true.)write(*,*)'Query:'read(*,*)i !读入学生序号if (i<=0.or.i>students) exitwrite(*,*)student(i) !写出学生成绩end dostopend0707program mainimplicit noneinteger,parameter::row=2integer,parameter::col=2integer::m(row,col)integer rinteger cdata((m(r,c),r=1,2),c=1,2)/1,2,3,4/write(*,"(I3,I3,/,I3,I3)")((m(r,c),c=1,2),r=1,2) stopend0708program ex0708implicit noneinteger, parameter :: row = 2integer, parameter :: col = 2integer :: ma(row, col) = 1integer :: mb(row, col) = 4integer :: mc(row, col)integer :: i,jmc = ma + mbwrite(*,"(I3,I3,/,I3,I3)") ((mc(i,j), i=1,2),j=1,2)stopend0709program ex0709implicit noneinteger, parameter :: row = 2integer, parameter :: col = 2integer :: a(2,2)=(/ 1,2,3,4 /)! a(1,1)=1, a(2,1)=2, a(1,2)=3, a(2,2)=4 integer :: b(4)=(/ 5,6,7,8 /)integer :: c(2)write(*,*) a ! a(1,1), a(2,1), a(1,2), a(2,2) write(*,*) a(:,1) ! a(1,1), a(1,2)c = a(:,1) ! c(1)=a(1,1), c(2)=a(2,1)write(*,*) c ! c(1), c(2)c = a(2,:) ! c(1)=a(2,1), c(2)=a(2,2)write(*,*) c ! c(1), c(2)write(*,*) c(2:1:-1) ! c(2), c(1)c = b(1:4:2) ! c(1)=b(1), c(2)=b(3)write(*,*) c ! c(1), c(2)stopend0710program ex0710implicit noneinteger :: iinteger :: a(5)=(/ (i,i=1,5) /) integer :: b(5)=0!把b中小于3的元素赋值给a where( a<3 )b = aend wherewrite(*,"(5(I3,1X))") bstopendprogram mainimplicit noneinteger::iinteger::a(5)=(/1,2,3,4,5/) integer::b(5)=0where(a<3) b=awrite(*,"(5(I3,1x))")bstopend0711program ex0711implicit noneinteger :: iinteger :: a(5)=(/ (i,i=1,5) /) integer :: b(5)=0where( a<3 )b = 1elsewhereb = 2end wherewrite(*,"(5(I3,1X))") bstopend0712program ex0712implicit noneinteger :: ireal :: income(10)=(/ 250000, 300000, 500000, 400000, 350000, &600000, 270000, 450000, 280000, 700000 /) real :: tex(10)=0where( income < 300000.0 )tex = income*0.10elsewhere( income < 500000.0 )tex = income*0.12elsewheretex = income*0.15end wherewrite(*,"(10(F8.1,1X))") texstopend0713program ex0713implicit noneinteger iinteger :: a(5)forall(i=1:5)a(i)=5end forall! a(1)=a(2)=a(3)=a(4)=a(5)=5write(*,*) aforall(i=1:5)a(i)=iend forall! a(1)=1, a(2)=2, a(3)=3, a(4)=4, a(5)=5write(*,*) astopend0714program ex0714implicit noneinteger I,Jinteger, parameter :: size = 5integer :: a(size,size)forall ( I=1:size, J=1:size, I>J ) a(I,J)=1 forall ( I=1:size, J=1:size, I==J ) a(I,J)=2 forall ( I=1:size, J=1:size, I<J ) a(I,J)=3write(*,"(5(5I5,/))") astopend0715program ex0715implicit noneinteger, parameter :: max = 1000 integer :: a(max)integer :: studentsinteger :: iwrite(*,*) "How many students:"read(*,*) studentsdo i=1,studentswrite(*,"('Number ',I3)") iread(*,*) a(i)end dostopend0716program ex0716implicit noneinteger :: studentsinteger, allocatable :: a(:)integer :: iwrite(*,*) "How many students:"read(*,*) studentsallocate( a(students) )do i=1,studentswrite(*,"('Number ',I3)") iread(*,*) a(i)end dostopend0717program ex0717implicit noneinteger :: size, error=0integer, parameter :: one_mb=1024*1024 character, allocatable :: a(:)do while( .true. )size=size+one_mballocate( a(size), stat=error )if ( error/=0 ) exitwrite(*,"('Allocate ',I10, ' bytes')") sizewrite(*,"(F10.2,' MB used')") real(size)/real(one_mb) deallocate( a )end dostopend0718program ex0718implicit noneinteger, parameter :: size=10integer :: a(size) = (/ 5,3,6,4,8,7,1,9,2,10 /)integer :: i,jinteger :: tdo i=1, size-1do j=i+1, sizeif ( a(i) > a(j) ) thent=a(i)a(i)=a(j)a(j)=tend ifend doend dowrite(*,"(10I4)") astopend0719program ex0719implicit noneinteger, parameter :: L=3, M=4, N=2real :: A(L,M) = (/ 1,2,3,4,5,6,7,8,9,10,11,12 /) real :: B(M,N) = (/ 1,2,3,4,5,6,7,8 /)real :: C(L,N)integer :: i,j,kdo i=1,Ldo j=1,NC(i,j) = 0.0do k=1,MC(i,j) = C(i,j)+A(i,k)*B(k,j)end doend doend dodo i=1,Lwrite(*,*) C(i,:)end dostopend。

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

FORTRAN95第十章排序、查找算法

要求线性表中的所有元素按照关键字有序(递增或递减)排列。假设线性表中元素按关键字递增排列，那么二分查找方法是:将
给定值与处于顺序表“中间位置”上的元素的关键字进行比较键字则在表的后半部分继续进行二分查找。否则在表的前半部分继续进行二分查找, 如此进行下去直至找到满足条件的元素，或当前查找区为空。
10.1.4 直接插入排序直接插入排序的方法是将待排记录分成两部分,初始第
一部分只含1个记录,在排序进程中把第二部分的全部记录逐步插入到第一部分,并使该部分每次插入记录后是有序的。直接插入排序算法步骤：
(1)将n个待排的记录数据存一维数组A中,默认A(1)为第一部分的记录,2=>I；
(2）若I<=n, 则第二部分的一个记录A(I)与第一部分记录进行比较, 找出在第一部分插入这个记录的位置，然后将该位置上原来的记录及其后面所有的记录顺序后移一个位置，在空出的位置上插入这个记录；若I>n (表示把第二部分的记录全部插入到第一部分) ,则结束排序；
10.1.2 冒泡排序冒泡排序是通过相邻两个排序记录的关键字的比
较,按一定次序互换逐步实现有序排序。冒泡排序的实现过程是:第一次冒泡排序,首先将第
一个记录的关键字和第二个记录的关键字进行比较, 若不满足顺序的要求，则将两个记录进行交换，然
后比较第二个记录和第三个记录的关键字并做同样
处理，依次类推，直至对第n-1个记录和第n个记录进行比较并处理完, 使得关键字值最大的记录被交换到了最后一个记录的位置上。第二次冒泡排序只需
integer::low,high,key,ix,mid integer,dimension(low:high):: a do while(low<=high)

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。

FORTRAN习题答案

FORTRAN习题答案习题二一、问答题1. 给出下面变量名称,哪些是合法变量？哪些是非法变量？说明原因。

Count 、num_2、x&y 、4x+5y 、china-suzhou 、$us 、AbCdE 、Mr.bai 、t5、_another 、school_class_25、#125、2002Y 、π、β、A01/02、alpha 、date(1) 1. 判定下面整数,指出哪些是合法整数,哪些是非法整数？说明原因。

-0、+ 215、$125、3,245,895、5.3245、5#384、-524_3、#5DFE 、23-345、16#1A2B 、38#ABCD 、8#275_2、+327890、4 #3212. 判定下面实数,指出哪些是合法实数,哪些是非法实数？说明原因。

-0E2、45.2345E3.5、-5489E25_8、-.2345E-35、$185.45E 、+ 2.753425E24_3、58D85、+0.E-0、-00000.001E5、5,443,223.44、-12 34E+2、+ 18.5E 18、2.5E42习题三一、选择题1．下面是V isual Fortran 中正确的表达式是。

（A ）A*COS(X)+∣B ∣ （B ）2*EXP(2*X)/SQRT(16.0)（C ）B 2-4AC （D ）MOD （24.5,0.5）2．下面算术赋值语句中正确的语句是。

（A ）M*N=(X-Y)/Z （B ）+R=A+B/C（C ）X=Y=Z-1.0 （D ）Y=A*B/C/D3．算术表达式1/3+2/3的值为。

（A ）0 （B ） 1 （C ） 0.99999999 （D ）值不确定二、问答题1. 将下列代数式用Visual Fortran 表达式描述：① ②③ 4sin 3A-3sinA+sin3A ④ 2．执行下列赋值语句后，变量中的值。

变量的类型遵循I —N 规则。

《FORTRAN-95程序设计》学习笔记

《FORTRAN-95程序设计》学习笔记《FORTRAN 95程序设计》学习笔记66RPG gg★目录★《FORTRAN 95程序设计》学习笔记 (2)基础知识(基础、字符串、FORMAT、隐式、TYPE)............................. 错误!未定义书签。

流程与控制(if、select、do) (8)数组(声明、隐式循环、整体操作、可变数组) (10)函数与子程序(子程序、函数、全局变量)13MODULE与面向对象(重载操作符、虚函数) (18)文件相关(OPEN、WRITE、READ) (20)指针（指向变量、数组、函数） (22)Visual Fortran 编译器（DLL，VB调用） (24)数值算法与IMSL（数值算法插件） (28)常用库函数（数学、数组、零碎、子程序） (30)◆10^10⏹复数：complex :: a=(2,3)◆实部：real(a) ；虚部：imag(a)⏹布尔型：Logical，.true. 和.false.★【语法与函数】字符串：character(20) string ⏹注意理解，fortran的弱智字符串就是一个长度不能变的一维的东西，极其猥琐，和Java、Ruby不能相提并论的⏹string(13:13) = “a”：对第13个字节的读、存⏹string(2:3) = “go”⏹string(6) = “我的妈呀”：从第6个位置开始设置为“我的妈呀”⏹a = string_a // string_b：用“//”连接两个字符串⏹【常用函数】char(num)，ichar(char)：ASCII码的转换相关功能⏹【常用函数】len(string)，len_trim(string)：长度，去掉尾部空格后的长度⏹【常用函数】index(string,key)：找key在string首出现的位置⏹【常用函数】trim(string)：返回去掉尾部空格的字符串(用途不大)⏹【函数】repeat(char,int)：返回一个重复int次的char串⏹character(len=20) string 普通声明；character(len=*) string 接收的时候可自动长度★【规范格式】FORMAT格式化⏹e.g.◆w rite (*,100) A◆100 format(I4) ←这里是100号标识调用的格式⏹参数控制符(前面加数字为重复次数，如4I6或<a>I6。

北京邮电大学出版社FORTRAN程序设计课后习题答案2

北京邮电大学出版社FORTRAN程序设计课后习题答案2北京邮电大学出版社FORTRAN程序设计课后习题答案2 PROGRAM EX3_4CHARACTER*1 LETTER!方法一print*,' 请输入一个英文字母：'READ*,LETTERif(LETTER>='A' .and. LETTER<='Z') THENwrite(*,*)' 你输入的',LETTER,'为大写字母。

'elseif(LETTER>='a' .and. LETTER<='z')THENwrite(*,*)' 你输入的',LETTER,'为小写字母。

'elsewrite(*,*)' 你输入的',LETTER,'不是字母。

'endif!方法二print*,' 请输入一个英文字母：'READ*,LETTERSELECT CASE(LETTER)CASE('A':'Z')write(*,*)' 你输入的',LETTER,'为大写字母。

'CASE('a':'z')write(*,*)' 你输入的',LETTER,'为小写字母。

'CASE DEFAULTwrite(*,*)' 你输入的',LETTER,'不是字母。

'ENDSELECT!方法三print*,' 请输入一个英文字母：'READ*,LETTERI=ICHAR(LETTER) !转化字符LETTER为对应的ASCII值if(i>=65 .and. i<=90) write(*,*)' 你输入的',LETTER,'为大写字母。

Fortran95程序设计课后习题答案(word版方便).docx

第四章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=3implicit none.14159real 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.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.54write(*,"(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.03else if ( money<5000) then tax=0.1else tax=0.15end 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.03else if ( money<5000 )then tax = 0.10else tax = 0.15end if else if(money<1000) then tax= 0.5else if( money<5000 )then tax = 0.7else tax = 0.10end 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 = 366else days = 365end if write(*,"('这一年有 'I3' 天 ')") days stop end program第六章1.program main implicit none integer i do i=1,5write(*,*)"Fortran"end do stop end program2.program main implicit none integer i,sum sum = 0do i=1,99,2sum = sum+i end do write(*,*) sum stop end program3.program main implicit none integer,parameter:: answer= 45integer,parameter :: max = 5integer 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=10integer i real item real ans ans = 1.0item = 1.0do i=2,max item = item/real(i)ans = ans+itemend do write(*,*) ans stop end program5.program main implicit none integer, parameter :: length = 79character(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 stop end program第七章1.program main implicit none integer,parameter:: max= 10integer 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=25integer b(2,3,4)!2*3*4=24integer 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=10integer f(max)integer i f(1)=0f(2)=1do 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=10integer:: a(size)=(/ 5,3,6,4,8,7,1,9,2,10/)integer::i,j integer::t do i=1, size-1do j=i+1,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)=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 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.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=0return 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=20real,parameter:: StartX=0.0,EndX=3.14159*2.0real,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+1callPutChar(px,py)x=x+xinc end docall UpdateScreen()stop end program第九章1.program main implicit none character(len=79)::character(len=79)::buffer integer,parameter:: fileid = 10integer count integer::status=0logical alive write(*,*)":"read(*,"(A79)")inquire(,exist=alive)if(alive)then open(unit=fileid, , &access="sequential", status="old")count = 0do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit!没有资料就跳出循环write(*,"(A79)")buffer count=count+1if( count==24)then pause count=0end if end do else write(*,*)TRIM(),"doesn't exist." end if stop end2.program main implicit none character(len=79)::character(len=79)::buffer integer, parameter :: fileid = 10integer i integer :: status = 0logical alive write(*,*) ":" read(*,"(A79)")inquire(, exist=alive)if (alive )then open(unit=fileid,,& 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()," 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=5integer 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)::character(len=79)::buffer integer, parameter :: fileid = 10integer i integer :: status = 0logical alive write(*,*) ":"read (*,"(A79)")inquire( , exist=alive)if ( alive ) then open(unit=fileid, , & 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()," 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::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 -1do 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! 4bytes real(kind=4):: b! 4 bytes real(kind=8):: c!8bytes character(len=10):: str!10bytes 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=>awrite(*,*) 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 ex1016use linklist implicit none character(len=20)::character(len=80):: tempstr type(datalink),pointer::head type(datalink),pointer:: p type(student), allocatable :: s(:)integer i,error,size write(*,*) ":"read(*,*)open(10, , status="old", iostat=error)if ( error/=0 ) then write(*,*) "Open !"stop end if allocate(head) nullify(head%next)p=>head size=0read(10, "(A80)") tempstr !读入第一行字符串 ,不需要处理它!读入每一位学生的成绩do while(.true.)read(10,fmt=*,iostat=error) p%item if( error/=0) exit size=size+1allocate(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 ex1012use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:'read(*,*) n allocate( head )head%i=1nullify(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.14159real 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 procedure rat__rat_div_rat end interface interface assignment(=)module procedure rat_eq_rat module procedure int_eq_rat module procedure real_eq_rat endinterface 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)::rat1type(rational),intent(in)::rat2rat1%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=1return 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=1return 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,rat2type(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, rat2type(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课后习题解答

!习题4-1!写出逻辑表达式的值PROGRAM XITI4_1REAL::A=2,B=7.5,C=-3.6LOGICAL::L1=.TRUE.,L2=.FALSE.PRINT*,A-7<B-6.5PRINT*,.NOT.L2.OR.B-A<=C/2.AND.C>=-3.6PRINT*,L2PRINT*,L1.EQV..NOT.L2.AND.L1.OR.3*A<=4-BPRINT*,ABS((C-A)-(B*A-C))<1E-6.OR.L1PRINT*,(A+C>B.AND.C**2>=10.0).NEQV.(L1.OR.L2) END!习题4-2!使用CASE结构PROGRAM CHENGJIINTEGER::GPRINT*,'请输入学生的成绩：'READ*,GSELECT CASE(G)CASE(90:100)PRINT*,'very good'CASE(80:89)PRINT*,'good'CASE(60:79)PRINT*,'pass'CASE(0:59)PRINT*,'fail'CASE DEFAULTPRINT*,'ERROR'END SELECTEND!习题4-2!使用IF结构PROGRAM MAINIMPLICIT NONEREAL::GPRINT*,'请输入学生的成绩：'READ*,GIF(G>=0.AND.G<=100)THENIF(G>=90)THENPRINT*,'VERY GOOD'ELSEIF(G>=80)THENPRINT*,'GOOD'ELSEIF(G>=60)THENPRINT*,'PASS'ELSEPRINT*,'FAIL'END IFELSEPRINT*,'ERROR'ENDIFEND PROGRAM MAIN!习题4-3PROGRAM MAINIMPLICIT NONEREAL::X,YPRINT*,'请输入X的值：'READ*,XIF(X>=0.AND.X<15)THENY=40*X/15+10PRINT*,'Y=',YELSEIF(X>=15.AND.X<30)THENY=50PRINT*,'Y=',YELSEIF(X>=30.AND.X<45)THENY=50-10*(X-30)/15PRINT*,'Y=',YELSEIF(X>=45.AND.X<75)THENY=40+20*(X-45)/30PRINT*,'Y=',YELSEIF(X>=75.AND.X<90)THENY=60-10*(X-75)/15PRINT*,'Y=',YELSEPRINT*,'X不在定义域内，无函数值' END IFEND PROGRAM MAIN!习题4-4PROGRAM MAINIMPLICIT NONEREAL::X1,X2,X3,Y1,Y2,Y3,X,YPRINT*,'INPUT X1,X2,X3,Y1,Y2,Y3'READ*,X1,X2,X3,Y1,Y2,Y3PRINT*,'INPUT X'IF(X>=X1.AND.X<X2) THENY=(Y2-Y1)/(X2-X1)*(X-X1)+Y1 ELSE IF(X>=X2.AND.X<=X3) THEN Y=(Y3-Y2)/(X3-X2)*(X-X2)+Y2 END IFPRINT*,YEND PROGRAM MAIN!习题4-5program mainimplicit nonereal::x,yprint*,"请输入购物额"read*,xif(x>=1000) theny=0.8*xelseif(x>=500) theny=0.9*xelseif(x>=200) theny=0.95*xelsey=xendifprint*,"应收货款",yend!习题4-6PROGRAM MAINIMPLICIT NONEINTEGER::APRINT*,'请输入一个整数：'READ*,AIF(MOD(A,2)==0)THENPRINT*,'是偶数'ELSEPRINT*,'是奇数'END IFEND PROGRAM MAIN!习题4-7PROGRAM MAININTEGER::MPRINT*,'请输入一个整数：'IF (MOD(M,7)==0) THENPRINT*,M,'能够被7(或11、17)整除' ELSEIF (MOD(M,11)==0) THENPRINT*,M,'能够被7(或11、17)整除' ELSEIF (MOD(M,17)==0) THENPRINT*,M,'能够被7(或11、17)整除' ELSEPRINT*,M,'不能够被7，11和17整除' END IFEND PROGRAM MAIN!习题4-8!冒泡法排序PROGRAM MAINIMPLICIT NONEINTEGER::A,B,C,D,EPRINT*,'INPUT A,B,C,D'READ*,A,B,C,DIF(A>B) THENE=AA=BB=EEND IFIF(B>C) THENE=BB=CC=EEND IFIF(C>D) THENE=CC=DD=EEND IFIF(A>B) THENE=AA=BB=EEND IFIF(B>C) THENE=BB=CC=EEND IFIF(A>B) THENE=AA=BB=EEND IFPRINT*,A,B,C,DEND PROGRAM MAIN!习题4-8!选择法排序program mainimplicit noneinteger::a,b,c,d,tprint*,'please input 正整数a,b,c,d'read*,a,b,c,dif (a>b) thent=aa=bb=tendifif (a>c) thent=aa=cc=tendifif (a>d) thent=aa=dd=tendifif (b>c) thent=bb=cc=tendifif (b>d) thent=bb=dd=tendifif (c>d) thent=cc=dd=tendifprint*,a,b,c,dend program main!习题4-8program mianimplicit noneinteger::a,b,c,d,e,f,gprint*,'请输入四个数字'read*,a,b,c,de=max(a,b,c)f=min(a,b,c)g=a+b+c-e-fprint*,'四个数由小到大排列为：'if(d>=e)thenprint *,f,g,e,delseif(d>=g)thenprint *,f,g,d,eelseif(d>=f)thenprint *,f,d,g,eelseprint *,d,f,g,eendifend program mian!习题4-9program mainimplicit nonereal::a,b,c,d,x,x1,x2,r,tprint*,'请输入a,b,c：'read*,a,b,cd=b**2-4*a*cif(a==0.and.b/=0) print*,'x=',-c/bif(a==0.and.b==0.and.c==0) p rint*,"x为任意值"if(a==0.and.b==0.and.c/=0) print*,"x无解"if(a/=0.and.d>0) thenx1=(-b+sqrt(d))/(2*a)x2=(-b-sqrt(d))/(2*a)print*,'x1=',x1,'x2=',x2end ifif(a/=0.and.abs(d)<1e-6) thenx=(-b+sqrt(d))/(2*a)print*,"x=",xend ifif(a/=0.and.d<0) thenr=-b/(2*a)t=abs(sqrt(-d)/(2*a))print*,"x1=",r,"+",t,"i"print*,"x2=",r,"-",t,"i"endifend!习题4-10PROGRAM MAINIMPLICIT NONEREAL::X,Y,M,NINTEGER::ZPRINT*,'INPUT(X,Y)'READ*,X,YM=SQRT(X**2+Y**2)IF(M<=20) THENZ=2ELSEZ=1END IFPRINT '(A,I1,A)',"该点的每亩地价为：",Z,"万元。

(完整)《FORTRAN 95程序设计》学习笔记

《FORTRAN 95程序设计》学习笔记66RPG gg★目录★《FORTRAN 95程序设计》学习笔记 (1)基础知识(基础、字符串、FORMAT、隐式、TYPE) (1)流程与控制(if、select、do) (4)数组(声明、隐式循环、整体操作、可变数组) (5)函数与子程序(子程序、函数、全局变量) (6)MODULE与面向对象(重载操作符、虚函数) (9)文件相关(OPEN、WRITE、READ) (10)指针（指向变量、数组、函数） (11)Visual Fortran 编译器（DLL，VB调用） (12)数值算法与IMSL（数值算法插件） (14)常用库函数（数学、数组、零碎、子程序） (15)基础知识(基础、字符串、FORMAT、隐式、TYPE)★【小玩意】二进制观察器：装在M.. Visual Studio\DF98\bin，有一个Bitviewer，可以观察变量储存方式★【语法】续行：行结尾或行开头使用& 符号；注释：使用! 符号★【语法】数学表达式：+ ；- ；* ；/ ；( ；) ；**乘幂★【语法】程序结束：STOP (Ruby的exit)★【语法】输出：write(*,*)，完整写法：write(unit=*,fmt=*)⏹建议：少用print，尽量用write★【语法】声明⏹整型：integer(kind=4) a ；其中kind是使用的bytes数，4 or 2◆其他写法：integer*4 a; integer(4) a⏹浮点：real(kind=4) a ；有效数位6位（12345678存为1.234567E7），如果是kind8则为15位有效数字◆此外：1E10：单精10^10，1D10：双精10^10⏹复数：complex :: a=(2,3)◆实部：real(a) ；虚部：imag(a)⏹布尔型：Logical，.true. 和.false.★【语法与函数】字符串：character(20) string⏹注意理解，fortran的弱智字符串就是一个长度不能变的一维的东西，极其猥琐，和Java、Ruby不能相提并论的⏹string(13:13) = “a” ：对第13个字节的读、存⏹string(2:3) = “go”⏹string(6) = “我的妈呀”：从第6个位置开始设置为“我的妈呀”⏹ a = string_a // string_b：用“//”连接两个字符串⏹【常用函数】char(num)，ichar(char)：ASCII码的转换相关功能⏹【常用函数】len(string)，len_trim(string)：长度，去掉尾部空格后的长度⏹【常用函数】index(string,key)：找key在string首出现的位置⏹【常用函数】trim(string)：返回去掉尾部空格的字符串(用途不大)⏹【函数】repeat(char,int)：返回一个重复int次的char串⏹character(len=20) string 普通声明；character(len=*) string 接收的时候可自动长度★【规范格式】FORMAT格式化⏹ e.g.◆write (*,100) A◆100 format(I4) ←这里是100号标识调用的格式⏹参数控制符(前面加数字为重复次数，如4I6或<a>I6。

fortran习题答案

fortran习题答案【篇一：fortran习题1答案】txt>上机目的：练习c语言的书写、循环和判断结构1. 编写程序实现摄氏度和华氏度的相互转换：f?c*9/5?32#include stdio.hint main(void){ float c,f;printf(请输入摄氏温度：\n);scanf(%f,c);f=c*9/5+32;printf(对应的华氏温度为：\n);printf(%.2f\n,f);}2. 打印出6行杨辉三角形如下图：11 11 2 11 3 3 11 4 6 4 11 5 10 10 5 1#include stdio.h#define n 6int main(){int a[n][n],i,j; for (i=0;in;i++) { a[i][0]=1; a[i][i]=1; } for(i=2;in;i++) for (j=1;ji;j++)a[i][j]=a[i-1][j-1]+a[i-1][j]; for(i=0;in;i++) {}for (j=0;j=i;j++)printf(%4d,a[i][j]); printf(\n); } return 0;3. 求出数列2/1，3/2，5/3，8/5，13/8，21/13...的前10项之和。

#include stdio.hint main(void){} float a,b,c,i,s; a=1;b=2;s=0; for (i=1;i=10;i++) { } printf(数列前10项的和为：%f\n,s); s=s+b/a; c=a+b; a=b; b=c;4. 输入若干实数，请编写程序用于统计每个正数和负数的个数。

5. 从键盘上输入三条边长，判断是否能组成三角形。

#include stdio.hint main(void){float a,b,c;printf(请输入三个边长：\n); scanf(%f%f%f,a,b,c);if (a+bca+cbb+ca) printf(这三条边可以围成三角形\n);} else printf(这三条边不可以围成三角形\n);6. 输入某个点的坐标（a, b)，判断该点是否位于圆心(x, y)、半径为r的圆内。

FORTRAN程序设计复习题及答案

FORTRAN程序设计复习题及答案FORTRAN程序设计复习题一、选择题B (1)下列各FORTRAN表达式中合法的是A) S+T*2P >= B) .NOT. (A*B+C)C) A2+B2/(C+D) <= D) (A+B).NOT．A*B．GT．(.NOT.只跟一个表达式)C (2)数学式(3/5)ex+y的FORTRAN表达式是A) 3*EXP(X+Y)/5 B) 3*E* *(X+Y)/C) (3/5)*EXP(X+Y)D) EXP(X+Y)D (3)下列FORTRAN77表达式中不合法的是A) A．GT．B．EQV．C．GT． D B) A．AND．B．AND．C．AND．DC) .NOT．(X．LE．D) A．LT．B．LT．C．LT．DD(4)下列叙述中不正确的是A) FORTRAN子程序可以单独编译B) 对一个FORTRAN源程序进行编译和连接无误后可生成可执行文件C) 即使编译和连接都正确无误，FORTRAN程序运行时仍可能出错D) FORTRAN连接的主要任务是把函数库中的函数翻译成机器指令(正确描述：主要任务为连接目标文件)B (5)在下列FORTRAN77运算符中，优先级最高的是A) .AND. B) .NOT. C) .OR. D) .EQ.B (6)FORTRAN表达式"6/5+9/2**3/2"的值为A) 33 B) 1 C) 5 D) 3A (7)下列FORTRAN77表达式中，合法的是：A) .AND.. B) 10.0C) D)提示：A）相当于 .AND.（.NOT.（））D (8)关于编译一个FORTRAN源程序文件，下列说法中错误的是A) 允许编译只有一个主程序而没有子程序的源文件B) 允许编译有多个子程序的源文件C) 允许编译只有一个子程序而没有主程序的源文件D) 允许编译有多个主程序的源文件C (9)在FORTRAN77源程序中，续行标志符必须放在A) 第1列 B) 第1-6列C) 第6列D) 第5列D (10)下列关于"SUBROUTINE MAP(X，Y)"语句行的叙述中，不正确的是A) 这是子程序的第一个语句 B) 字符串"MAP"是子程序名C) 变量X是子程序的形参D) 子程序执行后，MAP将返回整型数据提示：子程序无返回值，自定义函数才有）A (11)FORTRAN表达式"2/4+"的值是A) B) 1 C) D) 0提示：2/4默认等于整型，=》D (12)FORTRAN表达式"MOD，"的值是A) B)0.0 C) D)A (13下列FORTRAN运算符中，优先级最低的是A）逻辑运算符.AND. B）算术运算符*C)关系运算符 >= D)算术运算符＋A (14下列语句函数的定义中正确的是A）F(X，Y)＝(X＋Y)/(X*Y)＋ B）FUNCTION FUN(I，J，K)＝3*I ＋2*J＋*K C）H(A，B，C(I))＝SIN(A)＋SIN(B)＋C(I) D)S(A，B，C)＝A*B＋S(A*A，B，C)B（15下列标识符中，不属于FORTRAN常量的是A）.TRUE. B）FALSE C）ˊROOT＝ˊ D）ˊˊB（16）"整型变量M能被整型变量K整除"的FORTRAN77表达式是A）MOD(M，K)＝0 （MOD(M，K)= =0）B）M－M/K*K .EQ. 0C）MOD(K，M)＝0 D）MOD(M，K)＝0 == .TRUE.C （17）设有下列数组说明语句： REAL:: A(1:10，－1:10)该数组说明语句定义了数组A 中的元素个数为 A ）100 B ）110 C ）120 D ）121 A (18)按隐含规则（默认为整型），语句IP=执行之后，IP 的值是A) 3 B) 3.1416C)D)D (19)下列数据中，不符合 FORTRAN 常量表示法的是A) B)C)‘FOOT’‘=’ D) TRUEC (20)设C 是复型变量，A 与B 为有定义的实型变量，下列赋值语句中合法的是A) C=A+BB) C=,**2) C) C=,3D-2)D) C=(A ＋B ,A-B )B (21)有矩阵(数组)=22221111B下列DATA 语句中正确的是A) DATA B/4*,4* B) DATA((B(I,J), J=1,4), I=1,2)/4*, 4* C) DATA B/4*,/ D) DATA((B(I,J),I=1,2), J=1,4)/4*, 4* C (21)在使用DO 循环及循环嵌套时，下列叙述中正确的是A) 不仅可以从循环体内转到循环体外，也可以从循环体外转到循环体内 B) 外循环与内循环的DO 循环控制变量可以不同．也可以相同C) 可以从循环体内转到循环体外，但不能从循环体外转到循环体内 D)DO 循环控制变量在循环体内可以再赋值，也可以被引用B (22)在FORTRAN 表达式中，各种运算的顺序是 A) 逻辑运算，关系运算，算术运算B) 算术运算，关系运算，逻辑运算C) 关系运算，逻辑运算，算术运算D) 关系运算，算术运算，逻辑运算D (23)赋值语句X=4**(6/12)=4**0=执行后,实型变量X的值是A) 2 B) 2.0 C) 1 D)D (24)为了保证正确出数据,格式编辑符中w与d的关系应该是A) w>d B) w>d+2 C) w>d+4 D) w>d+6C (25)设下列各语句中用到的数组都已定义,则下列语句中正确的是A) READ(*,*)(I,A(I),I=1,10) B)READ(*,*)(B,(I,J),I=1,10,J=1,10)C) READ(*,*)N,(A(I),I=1,N) D) READ(*,*)(I=1,10,A(I))A (26)下列DO语句中,不正确实现循环的是(I-N规则：I-N会被视为整型)A) DO 10 S=,, B) DO 10 K=,,C) DO 10 S=,, D) DO 10 K=,,D (27)下列说法中正确的是A) 块IF结构中的THEN块或ELSE块不能是空块B) 块IF结构中至少有一个ELSE IF 语句或ELSE语句C) 每个ELSE IF 语句要有一个对应的END IF语句D) 一个块 IF 结构中只能有一个END IF语句A (28)下列数组说明语句中正确的是A) INTEGER A(-1:5,0:6)B) REAL M(10:5)C) DOUBLE Y(1:N+1) D) DOUBLE Z(14)B (29)设有一个FORTRAN77子程序如下:SUBROUTINE SS(X,Y,S,T)S=X+Y（S,T为传出，即需要输出的（相当于求圆的面积中的area），只能T=X*Y 为确定的数；X,Y为传入（相当于radius），可为表达式）END调用上述子程序的正确语句是A) CALL SS,W*W,5,,Z)（多了一个）B) CALL SS,,P,Q,R) （多了一个）C) CALL SS(F,G,,D) CALL SS*I,*J,C,D)（I,J可先赋值）A (30)在下列语句函数的定义中正确的是A) F(X,Y)=(X+Y)/(X*Y)+B) FUNCTION(I,J,K)=3*I+2*J+*KC) H(A,B,C(I))=SIN(A)+SIN(B)+C(I) D) S(A,B,C)=A*B+S(A*A,B,C)B (31)COMMON语句的功能是A) 给同一程序模块中的若干变量分配同一存储单元B) 给不同程序模块中的变量分配相同的存储单元C) 给程序中任意两个变量分配相同的存储单元D) 给同一程序模块中的不同变量分配相同的存储单元B (32)下列表达式中值为整数4的是A) SQRT B)27/6 C) 16** D) 4*C(34)语句K=2+**2/2执行后，整型变量 K的值是A) B) 5 C) 6D) 7C (36)适用于字符型 I/O的 FORTRAN77格式编辑将是A) B) C) A D)D (37)给定子例行程序如下SUBROUTINE SUB(K,A)B=K+2（K为整型，B）错误；A不是整型，A）错误；K为传入，可为表达式，A=A+B A为传出，不能为表达式）END下列调用语句中正确的是A) CALL SUB(N,N) B) CALL SUB(X,X)C) CALL SUB(N+2,X) D) CALL SUB(N,X+3)C (38) 下列FORTRAN语句中，正确的是A) READ(*,*) (N,A(K),K=1,N) B) WRITE(*,*) (M(K,J),K=1,10,J=1,10)C) WRITE(*,*) (10,A(K),K=1,10) D) DATA A,B,C/2*C (39)对于下列给定的FORTRAN说明和赋初值语句：INTEGER A(2，2)DATA A/3，4，5，6/数组元数A(2，1)的初值为A) 3 B) 5 C) 4 D) 6C(40)下列对公用区的说明语句中错误的是A) COMMON A(5), B B) COMMON/AB/ A(5), BC) COMMON AB/A(5), B/ D) COMMONND. IF>=X<= Y=2*X+D) IF(X >= <= Y=2*X+二、阅读题1、阅读下列FORTRAN程序:program examplereal a,b,ca=b=c=write(*,"(3)") a,b,cend程序运行的结果是:2、阅读下列FORTRAN程序：program exampleinteger :: a=1integer :: b=2real :: cc=a/bwrite(*,"") cend程序运行结果是:3、阅读下列FORTRAN程序:program exampleimplicit noneinteger rain, windspeedwrite(*,*) "Rain:"read(*,*) rainwrite(*,*) "Wind:"read(*,*) windspeedIf ( rain>=500 .or. windspeed >=10 ) then write(*,*) "停止上班上课"elsewrite(*,*) "照常上班上课"end ifstopend运行上述程序时，如果从键盘输入Rain：505<回车>Wind：8<回车>则最后输出的结果为: 停止上班上课4、阅读下列FORTRAN程序:program exampleimplicit nonereal a,b,anscharacter operatorread(*,*) aread(*,"(A1)") operator read(*,*) bselect case(operator)case('+')ans = a+bcase('-')ans = a-bcase('*')ans = a*bcase('/')ans = a/bcase defaultwrite(*,"('Unknown operator ',A1)") operator stop end selectwrite(*,",A1,,'=',") a,operator,b,ansstopend运行上述程序时，如果从键盘输入100<回车><回车>200<回车>则最后输出的结果为: Unknown operator5、阅读下列FORTRAN程序：program exampleimplicit noneinteger iinteger strleninteger, parameter :: key = 2character(len=20) :: stringwrite(*,*) "Encoded string:"read(*,*) stringstrlen = len_trim(string)do i = 1, strlenstring(i:i) = char( ichar(string(i:i)) + key ) end dowrite(*,"('String:',A20)") stringstopendBCDIJK<回车>则最后输出的结果为: DEFKLM6、阅读下列FORTRAN程序：program exampleimplicit noneinteger i,jdo i=1, 2do j=2, 3, 2write(*, "(I2,I2)") i,jend dowrite(*,*) "another circle"end dostopend程序运行的结果是: 1 2another circle2 2another circle（按输出格式，1、2前均有一空格。

fortran95作业答案

FORTRAN90程序设计[麒麟火小组]日期：[2013.7.5]土木工程1309班小组成员：曹阳201302655 裴思杰201302618张健201302601 徐嘉辰201302605作业：一．求一元方程的根1.采用语句函数或函数子程序定义一元方程；2.程序采用以下多种方法求方程的根；牛顿迭代法，二分法，迭代法程序利用控制变量（如nmethod）来选择计算方法。

Program Frist !一个可以选择子程序的主程序integer xuhaoprint*,"请选择方法：1：二分法。

2：迭代法。

3：牛顿迭代法。

"read*,xuhaoif(xuhao==1)then !将3种方法放在不同的子程序中，并用选择结构进行选择。

call bisection()endifif(xuhao==2)thencall diedai()endifif(xuhao==3)thencall niudun()endifendsubroutine bisection() !二分法的子程序real x1,x2,xreal bisect,func1 !对要调用的子程序作说明doprint*,"输入x1,x2的值："read*,x1,x2if(func1(x1)*func1(x2)<0.0)exitprint*,"不正确的输入！"enddox=bisect(x1,x2)print 10,'x=',x10format(a,f15.7)real function bisect(x1,x2) !二分法结构的函数子程序real x1,x2,x,f1,f2,fxx=(x1+x2)/2.0fx=func1(x)do while(abs(fx)>1e-6)f1=func1(x1)if(f1*fx<0)thenx2=xelsex1=xendifx=(x1+x2)/2.0fx=func1(x)enddobisect=xendreal function func1(x) !二分法的一元方程子程序real xfunc1=x**3-2*x**2+7*x+4endsubroutine diedai() !迭代法的子程序real xinteger mprint*,'请输入x0和最高循环次数的值:'read*,x,mcall iteration(x,m)endsubroutine iteration(x,m) !迭代法结构的函数子程序implicit nonereal x,x1real func2integer i,mi=1x1=func2(x)do while(abs(x-x1)>1e-6.and.i<=m)print 10,i,x1x=x1i=i+1x1=func2(x)if(i<=m)thenprint 20,'x=',x1elseprint 30,'经过',m,'次迭代后仍未收敛'endif10 format('i='i4,6x,'x='f15.7)20 format(a,f15.7)30 format(a,i4,a)endreal function func2(x) !迭代法一元方程的子程序real xfunc2=(-x**3+2*x**2-4)/7endsubroutine niudun() !牛顿迭代法的子程序real xinteger mprint*,'输入初值'read*,xcall newton(x)endsubroutine newton(x) !牛顿迭代法结构的函数子程序implicit nonereal x,x1real func3,dfunc3integer i,mi=1x1=x-func3(x)/dfunc3(x)do while (abs(x-x1)>1e-6)print 10,i,x1x=x1i=i+1x1=x-func3(x)/dfunc3(x)enddoprint 20,'x=',x110 format('i=',i4,6x,'x=',f15.7)20 format(a,f15.7)endreal function func3(x) !牛顿迭代法一元方程的函数子程序func3=x**3-2*x**2+7*x+4endreal function dfunc3(x) !牛顿迭代法一元方程的导数的子程序real xdfunc3=3*x**2-4*x+7end二．求解线性方程组用高斯消去法解线性方程组Ax=B的解，其中A为N*N系数矩阵，x为解向量，B为方程组右端n 维列向量。

FORTRAN95程序的设计实验

FORTRAN95程序设计实验班级：核工11：薛院院学号：2110302026实验一一.实验容一个边长为8.5m的边形草地。

计算八边形草地的面积并输出。

二.问题分析（流程图）三.程序!核工程11!薛院院!2013.03.11!计算8边形的面积PROGRAM COLUMATEREAL(4) A !定义边长REAL(8) B,PINTEGER(1) NUMBER !定义边数REAL(8) AREAL !定义面积PRINT*,'请输入多边形的边数' READ*,NUMBERPRINT*,'请输入多边形的边长' READ*,AB=A/2/sin(3.14/NUMBER)P=A/2+BAREAL=SQRT(P*(P-A)*(P-B)**2) PRINT*,'该多边形的面积为：',AREAL END!输入边数 8 ；输入边长8.5!输出结果：43.8四.实验结果实验二一.实验容计算还清贷款的月算二.问题分析三.程序!核工程11!薛院院!2013.03.11!计算还清贷款的月数!PROGRAM CALUCATEREAL P,D,R,MINTEGER M1PRINT*,'请分别输入贷款月利息贷款数以及每月尝还数' READ*,P,D,RA=LOG10(1.0)PRINT*,AM=(LOG10(P)-LOG10(P-D*R))/LOG10(1+R)M1=INT(M+0.5)PRINT*,M1END四.实验结果实验三一.实验容用case结构和seclect语句实现税值计算二.问题分析（流程图）三.程序!核工11!薛院院!2110302026!计算应该缴纳的税program calucate_moneyinteger incomereal::income_ratereal::rate_1=0.03,rate_2=0.05,rate_3=0.07,rate_4=0.10,rate_5=0.14,rate_6=0.20print*,'请输入收入（以万为单位）：' read*,incomeselect case(income)case(0:1000)income_rate=income*rate_1print*,'缴纳的税为： ',income_rate case(1001:2000)income_rate=income*rate_2print*,'缴纳的税为： ',income_rate case( 2001:5000)income_rate=income*rate_3print*,'缴纳的税为： ',income_rate case( 5001:10000)income_rate=income*rate_4print*,'缴纳的税为： ',income_rate case( 10001:50000)income_rate=income*rate_5print*,'缴纳的税为： ',income_rate case defaultincome_rate=income*rate_6print*,'缴纳的税为： ',income_rate end selectend四.实验结果实验四一.实验容计算1−12+13-14……+(−1)n+11n，其中n满足1+22+32……..+n2>a二.问题分析（流程图）三.程序!班级：核工11!:薛院院!日期：4.8!计算级数之和program mainreal::sum=1,term,sign=1,s=0 integer::a,i,n=0print*,'请输入一个较大的数（如10000）' read*,ado while(s<=a)n=n+1s=s+n**2enddodo i=1,nsign=-1*signterm=sign/isum=sum-termenddoprint*,sumend四.实验结果实验五一.实验容计算学生的平均成绩，每门课的平均成绩，三门课的平均成绩以及统计高于每门课的成绩和三门平均成绩的学生人数和占总人数的比例二.问题分析（流程图）三.程序!班级：核工程11!：薛院院!学号:2110302026!统计人数及比例program mainparameter(max=5)character*5::number(max)integer,dimension(3)::english,math,physicsreal::averages(max),english_ave,math_ave,physics_ave,average real::sum1=0,sum2=0,sum3=0integer(1)::n,n1=0,n2=0,n3=0,nn=0real::p1,p2,p3,ppprint*,'请输入学生人数'read*,nprint*,'请输入',n,'名学生的学号、英语、数学、物理成绩'print*,'数据之间用空格间隔。

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

第四章1.program mainimplicit nonewrite(*,*) "Have a good time."write(*,*) "That's not bad."write(*,*) '"Mary" isn''t my name.'end program2.program mainreal, parameter :: PI=3implicit none.14159real radiuswrite(*,*) "请输入半径长"read(*,*) radiuswrite(*,"(' 面积='f8. 3)") radius*radius*PIend program3.program mainimplicit nonereal gradeswrite(*,*) "请输入成绩"read(*,*) gradeswrite(*,"(' 调整后成绩为'f8.3)") SQRT(grades)*10.0end program4.integer a,breal ra,rba=2b=3ra=2.0rb=3.0write(*,*) b/a ! 输出1, 因为使用整数计算, 小数部分会无条件舍去write(*,*) rb/ra ! 输出1.55.program mainimplicit nonetype distancereal meter, inch, cmend typetype(distance) :: dwrite(*,*) "请输入长度:"read(*,*) d%meterd%cm = d%meter*100d%inch = d%cm/2.54write(*,"(f8.3'米='f8.3'厘米='f8.3'英寸')") d%meter, d%cm, d%inch end program第五章1.program mainimplicit noneinteger moneyreal taxwrite(*,*) "请输入月收入"read(*,*) moneyif ( money<1000 ) thentax = 0.03else if ( money<5000) thentax = 0.1elsetax = 0.15end ifwrite(*,"(' 税金为'I8)") nint(money*tax)end program2.program mainimplicit noneinteger daycharacter(len=20) :: tvwrite(*,*) "请输入星期几"read(*,*) dayselect case(day)case(1,4)tv = "新闻"case(2,5)tv = "电视剧"case(3,6)tv = "卡通"case(7)tv = "电影"case defaultwrite(*,*) "错误的输入"stopend selectwrite(*,*) tvend program3.program mainimplicit noneinteger age, moneywrite(*,*) "请输入年龄"read(*,*) agewrite(*,*) "请输入月收入"read(*,*) moneyif ( age<50 ) thenif ( money<1000 ) thentax = 0.03else if ( money<5000 )thentax = 0.10elsetax = 0.15end ifelseif ( money<1000 ) thentax = 0.5else if ( money<5000 )thentax = 0.7elsetax = 0.10end ifend ifwrite(*,"(' 税金为'I8)") nint(money*tax)end program4.program mainimplicit noneinteger year, dayslogical mod_4, mod_100, mod_400write(*,*) "请输入年份"read(*,*) yearmod_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 = 366elsedays = 365write(*,"('这一年有'I3'天')") daysstopend program第六章1.program mainimplicit noneinteger ido i=1,5write(*,*) "Fortran"end dostopend program2.program mainimplicit noneinteger i,sumsum = 0do i=1,99,2sum = sum+iend dowrite(*,*) sumstopend program3.program mainimplicit noneinteger, parameter :: answer = 45 integer, parameter :: max = 5 integer weight, ido i=1,maxwrite(*,*) "请输入体重"read(*,*) weightif ( weight==answer ) exitend doif ( i<=max ) thenwrite(*,*) "猜对了"elsewrite(*,*) "猜错了"end ifstop4.program mainimplicit noneinteger, parameter :: max=10 integer ireal itemreal ansans = 1.0item = 1.0do i=2,maxitem = item/real(i)ans = ans+itemend dowrite(*,*) ansstopend program5.program mainimplicit noneinteger, parameter :: length = 79 character(len=length) :: input, output integer i,jwrite(*,*) "请输入一个字串"read(*,"(A79)") inputj=1do i=1, len_trim(input)if ( input(i:i) /= ' ' ) thenoutput(j:j)=input(i:i)j=j+1end ifend dowrite(*,"(A79)") outputstopend program第七章1.program mainimplicit noneinteger, parameter :: max = 10 integer iinteger :: a(max) = (/ (2*i, i=1,10) /)! sum()是fortran库函数write(*,*) real(sum(a))/real(max)stopend program2.integer 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 mainimplicit noneinteger, parameter :: max=10integer f(max)integer if(1)=0f(2)=1do i=3,maxf(i)=f(i-1)+f(i-2)end dowrite(*,"(10I4)") fstopend program4.program mainimplicit noneinteger, parameter :: size=10integer :: a(size) = (/ 5,3,6,4,8,7,1,9,2,10 /) integer :: i,jinteger :: tdo i=1, size-1do j=i+1, sizeif ( a(i) < a(j) ) then ! a(i)跟a(j)交换t=a(i)a(i)=a(j)a(j)=tend ifend doend dowrite(*,"(10I4)") astopend5.a(2,2) ! 1+(2-1)+(2-1)*(5) = 7a(3,3) ! 1+(3-1)+(3-1)*(5) = 13第八章1.program mainimplicit nonereal radius, areawrite(*,*) "请输入半径长"read(*,*) radiuscall CircleArea(radius, area)write(*,"(' 面积= 'F8.3)") areastopend programsubroutine CircleArea(radius, area)implicit nonereal, parameter :: PI=3.14159real radius, areaarea = radius*radius*PIreturnend subroutine2.program mainimplicit nonereal radiusreal, external :: CircleAreawrite(*,*) "请输入半径长"read(*,*) radiuswrite(*,"(' 面积= 'F8.3)") CircleArea(radius)stopend programreal function CircleArea(radius)implicit nonereal, parameter :: PI=3.14159real radiusCircleArea = radius*radius*PIreturnend function3.program mainimplicit nonecall bar(3)call bar(10)stopend programsubroutine bar(length)implicit noneinteger, intent(in) :: lengthinteger icharacter(len=79) :: stringstring=" "do i=1,lengthstring(i:i)='*'end dowrite(*,"(A79)") stringreturnend subroutine4.program mainimplicit noneinteger, external :: addwrite(*,*) add(100)end programrecursive integer function add(n) result(sum) implicit noneinteger, intent(in) :: nif ( n<0 ) thensum=0returnelse if ( n<=1 ) thensum=nreturnend ifsum = n + add(n-1)returnend function5.program mainimplicit noneinteger, external :: gcdwrite(*,*) gcd(18,12)end programinteger function gcd(A,B)implicit noneinteger A,B,BIG,SMALL,TEMPBIG=max(A,B)SMALL=min(A,B)do while( SMALL /= 1 )TEMP=mod(BIG,SMALL)if ( TEMP==0 ) exitBIG=SMALLSMALL=TEMPend dogcd=SMALLreturnend function6.program mainuse TextGraphLibimplicit noneinteger, parameter :: maxx=60, maxy=20real, parameter :: StartX=0.0, EndX=3.14159*2.0 real, parameter :: xinc = (EndX-StartX)/(maxx-1) real xinteger i,px,pycall SetScreen(60,20)call SetCurrentChar('*')x=StartXdo px=1,maxxpy = (maxy/2)*sin(x)+maxy/2+1call PutChar(px,py)x=x+xincend docall UpdateScreen()stopend program第九章1.program mainimplicit nonecharacter(len=79) :: filenamecharacter(len=79) :: bufferinteger, parameter :: fileid = 10integer countinteger :: status = 0logical alivewrite(*,*) "Filename:"read (*,"(A79)") filenameinquire( file=filename, exist=alive)if ( alive ) thenopen(unit=fileid, file=filename, &access="sequential", status="old")count = 0do while(.true.)read(unit=fileid, fmt="(A79)", iostat=status ) bufferif ( status/=0 ) exit ! 没有资料就跳出循环write(*,"(A79)") buffercount = count+1if ( count==24 ) thenpausecount = 0end ifend doelsewrite(*,*) TRIM(filename)," doesn't exist."end ifstopend2.program mainimplicit nonecharacter(len=79) :: filenamecharacter(len=79) :: bufferinteger, parameter :: fileid = 10integer iinteger :: status = 0logical alivewrite(*,*) "Filename:"read (*,"(A79)") filenameinquire( file=filename, exist=alive)if ( alive ) thenopen(unit=fileid, file=filename, &access="sequential", status="old")do while(.true.)read(unit=fileid, fmt="(A79)", iostat=status ) bufferif ( status/=0 ) exit ! 没有资料就跳出循环do i=1, len_trim(buffer)buffer(i:i) = char( ichar(buffer(i:i))-3 )end dowrite(*,"(A70)") bufferend doelsewrite(*,*) TRIM(filename)," doesn't exist."end ifstopend3.program mainimplicit nonetype studentinteger chinese, english, math, science, social, totalend typetype(student) :: s, totalinteger, parameter :: students=20, subjects=5integer iopen(10,file="grades.bin",access="direct",recl=1)write(*,"(7A10)") "座号","中文","英文","数学","自然","社会","总分" total = student(0,0,0,0,0,0)do i=1, studentsread(10,rec=(i-1)*subjects+1) s%chineseread(10,rec=(i-1)*subjects+2) s%englishread(10,rec=(i-1)*subjects+3) s%mathread(10,rec=(i-1)*subjects+4) s%scienceread(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%totalwrite(*,"(7I10)") i, send dowrite(*,"(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)stopend4.program mainimplicit nonecharacter(len=79) :: filenamecharacter(len=79) :: bufferinteger, parameter :: fileid = 10integer iinteger :: status = 0logical alivewrite(*,*) "Filename:"read (*,"(A79)") filenameinquire( file=filename, exist=alive)if ( alive ) thenopen(unit=fileid, file=filename, &access="sequential", status="old")do while(.true.)read(unit=fileid, fmt="(A79)", iostat=status ) bufferif ( status/=0 ) exit ! 没有数据就跳出循环do i=1, len_trim(buffer)buffer(i:i) = char( ichar(buffer(i:i))-(mod(i-1,3)+1) )end dowrite(*,"(A70)") bufferend doelsewrite(*,*) TRIM(filename)," doesn't exist."end ifstopend5.module typedeftype studentinteger :: numinteger :: Chinese, English, Math, Natural, Socialinteger :: totalinteger :: rankend typeend moduleprogram mainuse typedefimplicit noneinteger, parameter :: fileid=10integer, parameter :: students=20character(len=80) :: tempstrtype(student) :: s(students) ! 储存学生成绩type(student) :: total ! 计算平均分数用integer i, num, erroropen(fileid, file="grades.txt",status="old", iostat=error)if ( error/=0 ) thenwrite(*,*) "Open grades.txt fail."stopend ifread(fileid, "(A80)") tempstr ! 读入第一行文字total=student(0,0,0,0,0,0,0,0)! 用循环读入每位学生的成绩do i=1,studentsread(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)%Totalend docall sort(s,students)! 重新输出每位学生成绩write(*,"(8A7)") "座号","中文","英文","数学","自然","社会","总分","名次" do i=1,studentswrite(*,"(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 typedefimplicit noneinteger ntype(student) :: s(n), tinteger i,jdo i=1,n-1do j=i+1,nif ( s(i)%total < s(j)%total ) thent = s(i)s(i)=s(j)s(j) = tend ifend doend doforall(i=1:n)s(i)%rank = iend forallend subroutine第十章1.integer(kind=4) :: a ! 4 bytesreal(kind=4) :: b ! 4 bytesreal(kind=8) :: c ! 8 bytescharacter(len=10) :: str ! 10 bytesinteger(kind=4), pointer :: pa ! 4 bytesreal(kind=4), pointer :: pb ! 4 bytesreal(kind=8), pointer :: pc ! 4 bytescharacter(len=10), pointer :: pstr ! 4 bytestype studentinteger Chinese, English, Mathend typetype(student) :: s ! 12 bytestype(student), pointer :: ps ! 4 bytes2.integer, target :: a = 1integer, target :: b = 2integer, target :: c = 3integer, pointer :: pp=>awrite(*,*) p ! 1p=>bwrite(*,*) p ! 2p=>cp=5write(*,*) c ! 53.module linklisttype studentinteger :: numinteger :: Chinese, English, Math, Science, Social end typetype datalinktype(student) :: itemtype(datalink), pointer :: nextend typecontainsfunction SearchList(num, head)implicit noneinteger :: numtype(datalink), pointer :: head, ptype(datalink), pointer :: SearchListp=>headnullify(SearchList)do while( associated(p) )if ( p%item%num==num ) thenSearchList => preturnend ifp=>p%nextend doreturnend functionend module linklistprogram ex1016use linklistimplicit nonecharacter(len=20) :: filenamecharacter(len=80) :: tempstrtype(datalink), pointer :: headtype(datalink), pointer :: ptype(student), allocatable :: s(:)integer i,error,sizewrite(*,*) "filename:"read(*,*) filenameopen(10, file=filename, status="old", iostat=error)if ( error/=0 ) thenwrite(*,*) "Open file fail!"stopend ifallocate(head)nullify(head%next)p=>headsize=0read(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 ) thenwrite(*,*) "Out of memory!"stopend ifp=>p%next ! 移动到链表的下一个数据nullify(p%next)end dowrite(*,"('总共有',I3,'位学生')") sizeallocate( s(size) )p=>headdo i=1,sizes(i)=p%itemp=>p%nextend dodo while(.true.)write(*,*) "要查询几号同学的成绩?"read (*,*) iif ( 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 dowrite(*,"('座号',I3,'不存在, 程序结束.')") istopend program4.module typedefimplicit nonetype :: datalinkinteger :: itype(datalink), pointer :: nextend type datalinkend module typedefprogram ex1012use typedefimplicit nonetype(datalink) , pointer :: p, head, nextinteger :: i,n,errwrite(*,*) 'Input N:'read(*,*) nallocate( head )head%i=1nullify(head%next)p=>headdo i=2,nallocate( p%next, stat=err )if ( err /= 0 ) thenwrite(*,*) 'Out of memory!'stopend ifp=>p%nextp%i=iend donullify(p%next)p=>headdo while(associated(p))write(*, "(i5)" ) p%ip=>p%nextend do! 释放链表的存储空间p=>headdo while(associated(p))next => p%nextdeallocate(p)p=>nextend dostopend program第十一章1.module utilityimplicit noneinterface areamodule procedure CircleAreamodule procedure RectArea end interfacecontainsreal function CircleArea(r)real, parameter :: PI=3.14159real rCircleArea = r*r*PIreturnend functionreal function RectArea(a,b)real a,bRectArea = a*breturnend functionend moduleprogram mainuse UTILITYimplicit nonewrite(*,*) area(1.0)write(*,*) area(2.0,3.0)stopend program2.module time_utilityimplicit nonetype :: timeinteger :: hour,minute,secondend type timeinterface operator(+)module procedure add_time_time end interfacecontainsfunction add_time_time( a, b )implicit nonetype(time) :: add_time_timetype(time), intent(in) :: a,binteger :: seconds,minutes,carryseconds=a%second+b%secondcarry=seconds/60minutes=a%minute+b%minute+carrycarry=minutes/60add_time_time%second=mod(seconds,60)add_time_time%minute=mod(minutes,60)add_time_time%hour=a%hour+b%hour+carryreturnend function add_time_timesubroutine input( a )implicit nonetype(time), intent(out) :: awrite(*,*) " Input hours:"read (*,*) a%hourwrite(*,*) " Input minutes:"read (*,*) a%minutewrite(*,*) " Input seconds:"read (*,*) a%secondreturnend subroutine inputsubroutine output( a )implicit nonetype(time), intent(in) :: awrite(*, "(I3,' hours',I3,' minutes',I3,' seconds')" ) a%hour,a%minute,a%secondreturnend subroutine outputend module time_utilityprogram mainuse time_utilityimplicit nonetype(time) :: a,b,ccall input(a)call input(b)c=a+bcall output(c)stopend program main3.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 main4.module vector_utilityimplicit nonetype vectorreal x,yend typeinterface operator(+)module procedure vector_add_vectorend interfaceinterface operator(-)module procedure vector_sub_vectorend interfaceinterface operator(*)module procedure real_mul_vectormodule procedure vector_mul_realmodule procedure vector_dot_vectorend interfaceinterface operator(.dot.)module procedure vector_dot_vectorend interfacecontainstype(vector) function vector_add_vector(a,b)type(vector), intent(in) :: a,bvector_add_vector = vector(a%x+b%x, a%y+b%y) end functiontype(vector) function vector_sub_vector(a,b)type(vector), intent(in) :: a,bvector_sub_vector = vector(a%x-b%x, a%y-b%y) end functiontype(vector) function real_mul_vector(a,b)real, intent(in) :: atype(vector), intent(in) :: breal_mul_vector = vector( a*b%x, a*b%y )end functiontype(vector) function vector_mul_real(a,b)type(vector), intent(in) :: areal, intent(in) :: bvector_mul_real = real_mul_vector(b,a) end functionreal function vector_dot_vector(a,b)type(vector), intent(in) :: a,bvector_dot_vector = a%x*b%x + a%y*b%y end functionsubroutine output(vec)type(vector) :: vecwrite(*,"('('F6.2','F6.2')')") vecend subroutineend moduleprogram mainuse vector_utilityimplicit nonetype(vector) a,b,ca=vector(1.0, 2.0)b=vector(2.0, 1.0)c=a+bcall output(c)c=a-bcall output(c)write(*,*) a*bend program main。