fortran习题参考答案

fortran编程习题答案Fortran编程习题答案Fortran是一种古老而强大的编程语言，广泛应用于科学计算和工程领域。

在学习Fortran编程的过程中，解决习题是一种非常有效的方法。

本文将为您提供一些Fortran编程习题的答案，帮助您更好地理解和掌握这门语言。

1. 习题一：编写一个Fortran程序，计算并输出1到100之间所有整数的平方。

程序代码如下：```fortranprogram squareimplicit noneinteger :: ido i = 1, 100print *, i, i**2end doend program square```2. 习题二：编写一个Fortran程序，计算并输出斐波那契数列的前20个数。

程序代码如下：```fortranprogram fibonacciimplicit noneinteger :: i, n, fib(20)fib(1) = 0fib(2) = 1do i = 3, 20fib(i) = fib(i-1) + fib(i-2)end dodo i = 1, 20print *, fib(i)end doend program fibonacci```3. 习题三：编写一个Fortran程序，计算并输出一个给定整数的阶乘。

程序代码如下：```fortranprogram factorialimplicit noneinteger :: i, n, resultprint *, "请输入一个整数："read *, nresult = 1do i = 1, nresult = result * iend doprint *, n, "的阶乘为：", resultend program factorial```4. 习题四：编写一个Fortran程序，计算并输出一个给定整数是否为素数。

程序代码如下：```fortranprogram primeimplicit noneinteger :: i, n, countprint *, "请输入一个整数："read *, ncount = 0do i = 2, n-1if (mod(n, i) == 0) thencount = count + 1end ifend doif (count == 0) thenprint *, n, "是素数"elseprint *, n, "不是素数"end ifend program prime```5. 习题五：编写一个Fortran程序，计算并输出一个给定整数的所有因子。

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中模块化编程的优点。

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

第三章C 3.11分期付款的计算(利率不可以很大!!!)DOUBLE PRECISION MPRINT *,'请输入从银行贷款数，每月偿还数，以及月利率'READ(*,*) D,P,RM=(LOG(P)-LOG(P-D*R))/LOG(1+R)PRINT *,'你需要还款',M,'个月'ENDC 3.12 借款额计算（年利率要小一点）DOUBLE PRECISION D,IPRINT *, '请输入每年准备还银行多少钱，年利率，以及打算还多少年' READ (*,*) A,R,NI =1+RD=A*(I**N-1)/((I-1)*(I**N))PRINT *, '你可以借款',D,'元'END第四章C 4.6 判断一个数能不能被7，11，17整除INTEGER IPRINT *, '请输入一个整数'READ (*,*) IIF((MOD(I,7)) .EQ. 0) THENPRINT *,'这个数能被7整除'END IFIF( (MOD(I,11)) .EQ. 0) THENPRINT *,'这个数能被11整除'END IFIF( (MOD(I,17)) .EQ. 0) THENPRINT *,'这个数能被17整除'END IFIF( (MOD(I,7) .NE. 0 ) .AND. (MOD(I,11) .NE. 0 ) .AND.& (MOD(I,17) .NE. 0 ) ) THENPRINT *, '这个数不能被7，11，17 整除' END IFENDC 4.8 输入四个数后排序（我用的是数组冒泡法！！！！，大家可以参照87页4.4看着写一下）INTEGER A(1:4)PRINT *,'请输入四个数'READ (*,*) A(1),A(2),A(3),A(4)TEMP=A(1)DO 100 I=1,4DO 10 J=I+1,4IF(A(I).LT.A(J)) THENTEMP=A(I)A(I)=A(J)A(J)=TEMPEND IF10 CONTINUE100 CONTINUEPRINT *, A(1), A(2), A(3), A(4)END第五章C 5.4 求SIN X 的值（这里N如果大了就算不出来了！！！）DOUBLE PRECISION SIN,Q,SQ=1SIN=0PRINT *, '请输入X的值'READ (*,*) XDO 10,N=1,4DO 100,M=1,(2*N-1)Q=M*Q100 CONTINUES=((-1)**(N+1))*(X**M)/QSIN=S+SIN10 CONTINUEPRINT *, 'SIN X=' ,SINENDC 5.8 找出所有的水仙花数DO 10,B=1,9DO 100,S=0,9DO 1000,G=0,9IF((B*100+S*10+G) .EQ. (B**3+S**3+G**3)) THENPRINT *, B*100+S*10+G ,'是水仙花数'END IF1000 CONTINUE100 CONTINUE10 CONTINUEEND第六章C 6.4 求三角形面积和重心坐标COMPLEX A,B,C,DDOUBLE PRECISION SA=(1.5,2.0)B=(4.5,4.5)C=(18.0,10.5)D=(A+B+C)/3AB=ABS(A-B)CB=ABS(C-B)CA=ABS(C-A)COSB=(CB**2+AB**2-CA**2)/(2*CB*AB)SINB=SQRT(1-COSB**2)S=1/2.0*SINB*AB*CBPRINT *,'三角形面积为',S,' 三角形重心为', D ENDC 6.8 使单词逆序输出PROGRAM MAINCHARACTER *(100)LINEWRITE (*,*)'请输入一个字符串'READ (*,*)LINEL=LENGTH(LINE)WRITE(*,*)(LINE(I:I),I=L,1,-1)ENDCFUNCTION LENGTH(LINE)CHARACTER *(*)LINEI=LEN(LINE)DO 10 WHILE((I.GT.0).AND.(LINE(I:I).EQ.' '))I=I-110 CONTINUELENGTH=IENDC 6.9 输出星花菱形(中间为30列我没管，大家可以参照复印的材料上的)CHARACTER * 9 LINEDO 10 I=1,5DO 20 J=6-I,4+ILINE(J:J)='*'20 CONTINUEWRITE (*,*)LINE10 CONTINUEDO 30 I=6,9LINE=' 'DO 40 J=I-4,14-ILINE(J:J)='*'40 CONTINUEWRITE(*,*)LINE 30 CONTINUEEND。

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 规则。

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

Program ex1_1implicit nonereal a,b,c,fprint*,'请输入a,b,c(角度值)'read*,a,b,ca=a*3.14159/180.0b=b*3.14159/180.0c=c*3.14159/180.0f=cos(abs(a+b))/sin(sqrt(abs(a)+abs(b)))+tan(c)write(*,*)'f=',fstopEnd2.设圆锥体底面半径r 为6，高h 为5，从键盘输入r 、h ，计算圆锥体体积。

计算公式为V=32h r π。

Program ex1_2implicit nonereal r,h,vprint*,'请输入r,h 的值'read*,r,hv=3.14159*r*r*h/3write(*,*)'v=',vstopEnd3.求一元二次方程02=++c bx ax 的两个根1x 和2x 。

方程的系数a 、b 、c 值从键盘输入并假定042>-ac b 。

Program ex1_3implicit nonereal a,b,c,x1,x2print*,'请输入a,b,c 的值'read*,a,b,cx1=(b+sqrt(b*b-4*a*c))/2*ax2=(b-sqrt(b*b-4*a*c))/2*awrite(*,*)'x1=',x1,'x2=',x2stopEnd4.从键盘输入一个三位十进制整数，分别输出其个位、十位、百位上的数字。

Program ex1_4implicit noneinteger xprint*,'请输入一个三位十进制整数'read*,xwrite(*,*)'个位数=',mod(x,10)write(*,*)'十位数=',mod(x/10,10)write(*,*)'百位数=',x/100stopEnd5.已知ysin(⋅)+=+，分别计算等号两边的算式并输出计算⋅sinyxcosxycosx sin结果（x=30°,y=45°从键盘输入）。

fortran考试题及答案分开1. 以下哪个选项是Fortran语言中正确的整型变量声明？A. INTEGER xB. REAL xC. COMPLEX xD. LOGICAL x答案：A2. Fortran程序中，哪个关键字用于定义数组？A. ARRAYB. LISTC. VECTORD. DIMENSION答案：D3. 在Fortran中，以下哪个选项是正确的条件语句？A. IF (x > 0) THENPRINT *, 'x is positive'B. IF x > 0 THENPRINT *, 'x is positive'C. IF (x > 0)PRINT *, 'x is positive'D. IF x > 0PRINT *, 'x is positive'答案：A4. Fortran中用于循环结构的关键字是什么？A. LOOPB. ITERATEC. DOD. FOR答案：C5. 如何在Fortran程序中包含另一个文件？A. 使用INCLUDE语句B. 使用IMPORT语句C. 使用INCLUDE关键字D. 使用IMPORT关键字答案：A6. Fortran中，哪个函数用于计算数组元素的总和？A. SUMB. TOTALC. AGGREGATED. ACCUMULATE答案：A7. 在Fortran中，如何声明一个具有默认值的变量？A. INTEGER :: x = 0B. INTEGER x = 0C. INTEGER x DEFAULT 0D. INTEGER x = DEFAULT 0答案：A8. Fortran程序中的主程序必须以哪个关键字开始？A. PROGRAMB. MAINC. PROCEDURED. FUNCTION答案：A9. 在Fortran中，如何声明一个二维数组？A. INTEGER :: matrix(10, 10)B. INTEGER :: matrix[10][10]C. INTEGER :: matrix(10)(10)D. INTEGER :: matrix(10,10)答案：A10. Fortran中用于计算数组元素平均值的函数是什么？A. AVGB. MEANC. AVERAGED. SUM答案：C。

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课后习题答案在学习Fortran编程语言时，课后习题是巩固知识、提高编程能力的重要途径。

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

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

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

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

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

一、判断题（共20分，每题1分，√表示对，×表示错）1．FORTRAN源程序的一条语句无法在一行内写下时，在行末用续行标志“！”，表示下一行是当前行的继续。

2．语句X=X+1的含义是将内存中名为X+1的存储单元的值赋给变量X。

3．如果程序单元中有说明语句PARAMETER（A=2.1），则不允许在该程序单元中改变A的值。

4．主程序和子程序可以储存到不同的文件中。

5．即使编译和连接都正确无误，FORTRAN程序运行时仍可能出错。

6．在数据块子程序中，可以调用另一个数据块子程序。

7．设有如下输入语句READ '(1X, F5.2)' , X若由键盘输入：12.3456789，则变量Y的值为12.34。

8．如果有以下程序段CHARACTER::A=’FORTRAN’则A内存储的实际值是’F’。

9．M=2000，为了在屏幕上输出□□***2000*** （其中□表示空格）。

则应使用的语句为：WRITE(*,100)M100 FORMAT(2X,’***’,I4,’***’)10．模块可用USE引用，也可用CALL调用。

11．语句函数定义语句在程序内的位置是：在程序块开头语句之后，END语句之前。

12．若有以下程序段：INTEGER,POINTER ::P1, P2INTEGER,TARGET::I=20, J=30P1=>I; P2=>J; P1=>P2; P2=>P1运行程序，I、J的值都为20。

13．COMMON语句的功能是给不同程序模块中的若干变量分配同一存储单元。

14．设C是复型变量，A、B是实型变量。

把A 的值赋给C的实部，把B的值赋给C的虚部的赋值语句是C=CMPLX(A,B)。

15．顺序存储结构的存储一定是连续的，链式存储结构的存储空间不一定是连续的。

16．A2B的FORTRAN表达式为A**2*B。

17．程序中说明了变量a具有POINTER属性，若a=>b，则b应具有PARAMETER属性。

北京邮电大学出版社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,'为大写字母。

软件技术基础(FORTRAN)笔试模拟试题(带答案)一．概念选择题（单选题，将正确的答案填入括号内。

每题1分，共15分）1. 已知整型变量L=5，M=13，N=4，表达式L*M/N 、L/N*M 和M/N*L 的值分别是（A ）。

A ）16 13 15B ）16.25 16.25 16.25C ）16.0 13.0 15.0D ）16 16 162．将数学式)||(ln 215-+e x 改写为FORTRAN 表达式，正确的是( D )。

A) 1/2*(LOG(ABS(X))+E**(-5))B) 1.0/2*(LN(ABS(X))+E**-5)C) 1/2.0*(LN(ABS(X))+E -5)D) 1.0/2*(LOG(ABS(X))+EXP(-5))3. 设A=.TRUE., B=.FALSE., C=.FALSE., 逻辑表达式(A.OR.B).AND.C 与A.OR..NOT.B 的值是( B )。

A) .T. 与 .F. B).F . 与 .T. C) .T. 与 .T. D) .F. 与 .F .4. 数组REAL A （0:5，-1:5）的元素个数是 （ D ）。

A ）25B ）30C ）36D ）42 5. 下列数组说明符中错误的是（ A ）。

A ）K(3:2,1:2)B ) K(-1:1,2)C ）K(-2:2,-1:1)D ）K(2:2,5)6. 关于USE 语句的正确说法是（ C ）。

A)USE 语句是可执行语句 B)用USE 语句可以代替INCLUDE 语句C)USE 语句必须放在程序单元体的开头 D)USE 语句的位置任意7. 语句OPEN （9，FILE=‘DATA.TXT ’）打开的是 ( B ) 文件。

A ）无格式顺序B ）有格式顺序C ）无格式直接D ）有格式直接8. 阅读下列FORTRAN 程序, 程序运行时执行循环体的次数是( A )。

X=0DO L=10, 5, 1X=X+1.0ENDDOENDA) 0 B) 1 C) 6 D) 无穷9．结构化程序设计中有三种基本结构,下列不属于三种基本设计结构的是( D )。

第四章1.program main implicit none write(*,*) "Have a good time." write(*,*) "That's not bad." write(*,*) '"Mary" isn''t my name.' end program2.program main real, parameter :: PI=3 implicit none.14159 real radius write(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积='f8. 3)") radius*radius*PI end program3.program main implicit none real grades write(*,*) "请输入成绩" read(*,*) grades write(*,"(' 调整后成绩为 'f8.3)") SQRT(grades)*10.0 end program4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a ! 输出1, 因为使用整数计算, 小数部分会无条件舍去 write(*,*) rb/ra ! 输出1.55.p rogram main implicit none type distance real meter, inch, cm end type type(distance) :: d write(*,*) "请输入长度:" read(*,*) d%meter d%cm =d%meter*100 d%inch = d%cm/2.54 write(*,"(f8.3'米 ='f8.3'厘米 ='f8.3'英寸')")d%meter, d%cm, d%inch end program第五章1.program main implicit none integer money real tax write(*,*) "请输入月收入" read(*,*) money if ( money<1000 ) then tax = 0.03 else if( money<5000) then tax = 0.1 else tax = 0.15 end if write(*,"(' 税金为 'I8)") nint(money*tax) end program2.program main implicit none integer day character(len=20) :: tv write(*,*) "请输入星期几" read(*,*) day select case(day) case(1,4) tv= "新闻" case(2,5) tv = "电视剧" case(3,6) tv = "卡通" case(7) tv = "电影" case default write(*,*) "错误的输入" stop end select write(*,*) tv end program3.program main implicit none integer age, money real tax write(*,*) "请输入年龄" read(*,*) age write(*,*) "请输入月收入" read(*,*) money if( age<50 ) then if ( money<1000 ) then tax = 0.03 else if ( money<5000 )then tax = 0.10 else tax = 0.15 end if else if ( money<1000 ) then tax =0.5 else if ( money<5000 )then tax = 0.7 else tax = 0.10 end if end if write(*,"(' 税金为 'I8)") nint(money*tax) end program4.program main implicit none integer year, days logical mod_4, mod_100,mod_400 write(*,*) "请输入年份" read(*,*) year mod_4 = ( MOD(year,4) ==0 ) mod_100 = ( MOD(year,100) == 0 ) mod_400 = ( MOD(year,400) == 0 ) if( (mod_4 .NEQV. mod_100) .or. mod_400 ) then days = 366 else days = 365end 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 ) thenwrite(*,*) "猜对了" else write(*,*) "猜错了" end if stop end program4.program main implicit none integer, parameter :: max=10 integer i realitem 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 main implicit none integer, parameter :: max = 10 integer i integer :: a(max) = (/ (2*i, i=1,10) /) integer :: t ! sum()是fortran库函数write(*,*) real(sum(a))/real(max) stop end program2.integer a(5,5) ! 5*5=25 integer b(2,3,4) ! 2*3*4=24 integer c(3,4,5,6) !3*4*5*6=360 integer d(-5:5) ! 11 integer e(-3:3, -3:3) ! 7*7=493.program main implicit none integer, parameter :: max=10 integer f(max) integer i f(1)=0 f(2)=1 do i=3,max f(i)=f(i-1)+f(i-2) end do write(*,"(10I4)") f stop end program4.program main implicit none integer, parameter :: size=10 integer :: a(size)= (/ 5,3,6,4,8,7,1,9,2,10 /) integer :: i,j integer :: t do i=1, size-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) = 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 nonereal, parameter :: PI=3.14159 real radius, area area = radius*radius*PIreturn end subroutine2.program main implicit none real radius real, external :: CircleAreawrite(*,*) "请输入半径长" 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 integeri character(len=79) :: string string=" " do i=1,length string(i:i)='*'end do write(*,"(A79)") string return end subroutine4.p rogram main implicit none integer, external :: add write(*,*) add(100)end program recursive integer function add(n) result(sum) implicit none integer, intent(in) :: n if ( n<0 ) then sum=0 return else if ( n<=1 )then sum=n return end if sum = n + add(n-1) return end function5.program main implicit none integer, external :: gcd write(*,*) gcd(18,12)end program integer function gcd(A,B) implicit none integerA,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 dogcd=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=StartXdo px=1,maxx py = (maxy/2)*sin(x)+maxy/2+1 call PutChar(px,py) x=x+xincend docall UpdateScreen() stop end program第九章1.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer count integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old")count = 0 do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status )buffer if ( status/=0 ) exit ! 没有资料就跳出循环 write(*,"(A79)")buffer count = count+1 if ( count==24 ) then pause count = 0 endif end do else write(*,*) TRIM(filename)," doesn't exist." end ifstop end2.p rogram main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer iinteger :: 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 ) bufferif ( status/=0 ) exit ! 没有资料就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-3 ) end do write(*,"(A70)") bufferend do else write(*,*) TRIM(filename)," doesn't exist." end if stop end3.program main implicit none type student integer chinese, english, math, science, social, total end type type(student) :: s, total integer, parameter :: students=20, subjects=5 integer i open(10,file="grades.bin",access="direct",recl=1) write(*,"(7A10)") "座号","中文","英文","数学","自然","社会","总分" total = student(0,0,0,0,0,0) do i=1, students read(10,rec=(i-1)*subjects+1) s%chinese read(10,rec=(i-1)*subjects+2) s%english read(10,rec=(i-1)*subjects+3) s%math read(10,rec=(i-1)*subjects+4) s%science read(10,rec=(i-1)*subjects+5)s%social s%total = s%chinese+s%english+s%math+s%science+s%social total%chinese= total%chinese+s%chinese total%english = total%english+s%english total%math =total%math+s%math total%science = total%science+s%science total%social =total%social+s%social total%total = total%total+s%total write(*,"(7I10)") i,s end do write(*,"(A10,6F10.3)") "平均", & real(total%chinese)/real(students),&real(total%english)/real(students),& real(total%math)/real(students),& real(total%science)/real(students),&real(total%social)/real(students),& real(total%total)/real(students)stop 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) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit ! 没有数据就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-(mod(i-1,3)+1) ) end do write(*,"(A70)") buffer end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end5.module typedef type student integer :: num integer :: Chinese, English, Math, Natural, Social integer :: total integer :: rank end type end module program main use typedef implicit none integer, parameter :: fileid=10 integer, parameter :: students=20 character(len=80) :: tempstr type(student) :: s(students) ! 储存学生成绩 type(student) :: total ! 计算平均分数用integer i, num, error open(fileid,file="grades.txt",status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open grades.txt fail." stop end if read(fileid, "(A80)") tempstr ! 读入第一行文字 total=student(0,0,0,0,0,0,0,0) ! 用循环读入每位学生的成绩do i=1,students read(fileid,*) s(i)%num, s(i)%Chinese,s(i)%English, & s(i)%Math, s(i)%Natural, s(i)%Social ! 计算总分 s(i)%Total = s(i)%Chinese + s(i)%English + & s(i)%Math +s(i)%Natural + s(i)%Social ! 累加上各科的分数, 计算各科平均时使用total%Chinese = total%Chinese + s(i)%Chinese total%English = total%English +s(i)%English total%Math = total%Math + s(i)%Math total%Natural = total%Natural + s(i)%Natural total%Social = total%Social + s(i)%Social total%Total = total%Total + s(i)%Total end do call sort(s,students) ! 重新输出每位学生成绩 write(*,"(8A7)") "座号","中文","英文","数学","自然","社会","总分","名次" do i=1,students write(*,"(8I7)") s(i) end do ! 计算并输出平圴分数write(*,"(A7,6F7.1)") "平均", &real(total%Chinese)/real(students),& real(total%English)/real(students),&real(total%Math) /real(students),& real(total%Natural)/real(students),&real(total%Social) /real(students),& real(total%Total) /real(students) stop end program subroutine sort(s,n) use typedef implicit none integer n type(student) :: s(n), t integer i,j do i=1,n-1 do j=i+1,n if( s(i)%total < s(j)%total ) then t = s(i) s(i)=s(j) s(j) = t end ifend do end do forall(i=1:n) s(i)%rank = i end forall end subroutine第十章1.integer(kind=4) :: a ! 4 bytes real(kind=4) :: b ! 4 bytes real(kind=8) :: c !8 bytes character(len=10) :: str ! 10 bytes integer(kind=4), pointer :: pa !4 bytes real(kind=4), pointer :: pb ! 4 bytes real(kind=8), pointer :: pc !4 bytes character(len=10), pointer :: pstr ! 4 bytes type student integer Chinese, English, Math end type type(student) :: s ! 12 bytes type(student), pointer ::ps ! 4 bytes2.integer, target :: a = 1 integer, target :: b = 2 integer, target :: c = 3 integer, pointer :: p p=>a write(*,*) p ! 1 p=>b write(*,*) p ! 2 p=>c p=5 write(*,*) c !53.module linklist type student integer :: num integer :: Chinese, English,Math, Science, Social end type type datalink type(student) :: item type(datalink), pointer :: next end type contains function SearchList(num, head) implicit none integer :: num type(datalink), pointer :: head, p type(datalink), pointer :: SearchList p=>head nullify(SearchList) do while( associated(p) ) if ( p%item%num==num ) then SearchList => p return end if p=>p%next end do return end function end module linklist programex1016 use linklist implicit none character(len=20) :: filename character(len=80) :: tempstr type(datalink), pointer :: head type(datalink), pointer :: p type(student), allocatable :: s(:) integer i,error,size write(*,*) "filename:" read(*,*) filename open(10, file=filename, status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open file fail!" stop end if allocate(head) nullify(head%next) p=>head size=0 read(10, "(A80)") tempstr ! 读入第一行字符串, 不需要处理它 ! 读入每一位学生的成绩 do while(.true.) read(10,fmt=*, iostat=error) p%item if ( error/=0 )exit size=size+1 allocate(p%next, stat=error) ! 新增下一个数据 if ( error/=0 )then write(*,*) "Out of memory!" stop end if p=>p%next ! 移动到链表的下一个数据 nullify(p%next) end do write(*,"('总共有',I3,'位学生')") size allocate( s(size) ) p=>head do i=1,size s(i)=p%item p=>p%next end do do while(.true.) write(*,*) "要查询几号同学的成绩?" read (*,*) i if( i<1 .or. i>size ) exit ! 输入不合理的座号 write(*,"(5(A6,I3))") "中文",s(i)%Chinese,& "英文",s(i)%English,& "数学",s(i)%Math,& "自然",s(i)%Science,& "社会",s(i)%Social end do write(*,"('座号',I3,'不存在, 程序结束.')") i stopend program4.module typedef implicit none type :: datalink integer :: i type(datalink), pointer :: next end type datalink end module typedef programex1012 use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:' read(*,*) n allocate( head ) head%i=1 nullify(head%next) p=>head do i=2,n allocate( p%next,stat=err ) if ( err /= 0 ) then write(*,*) 'Out of memory!' stop end if p=>p%next p%i=i end do nullify(p%next) p=>head do while(associated(p)) write(*, "(i5)" ) p%i p=>p%next end do ! 释放链表的存储空间p=>head do while(associated(p)) next => p%next deallocate(p) p=>next end do stop end program第十一章1.module utility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r) real, parameter :: PI=3.14159 real r CircleArea =r*r*PI return end function real function RectArea(a,b) real a,b RectArea = a*b return end function end module program main use UTILITY implicit none write(*,*) area(1.0) write(*,*) area(2.0,3.0) stop end program2.module time_utility implicit none type :: time integer :: hour,minute,second end type time interface operator(+) module procedureadd_time_time end interface contains function add_time_time( a, b ) implicit none type(time) :: add_time_time type(time), intent(in) :: a,binteger :: seconds,minutes,carry seconds=a%second+b%second carry=seconds/60 minutes=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 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 nonetype(time), intent(in) :: a write(*, "(I3,' hours',I3,' minutes',I3,'seconds')" ) a%hour,a%minute,a%second return end subroutine output endmodule time_utility program main use time_utility implicit nonetype(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 procedurerat__rat_plus_rat end interface interface operator(-) module procedurerat__rat_minus_rat end interface interface operator(*) module procedurerat__rat_times_rat end interface interface operator(/) module procedurerat__rat_div_rat end interface interface assignment(=) module procedurerat_eq_rat module procedure int_eq_rat module procedure real_eq_rat endinterface interface operator(>) module procedure rat_gt_rat endinterface interface operator(<) module procedure rat_lt_rat endinterface interface operator(==) module procedure rat_compare_rat endinterface interface operator(/=) module procedure rat_ne_rat endinterface contains function rat_gt_rat(a,b) implicit none logical ::rat_gt_rat type(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_rat function rat_lt_rat(a,b) implicit none logical :: rat_lt_rat type(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) implicitnone logical :: 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 return end function rat_compare_rat function rat_ne_rat(a,b) implicitnone 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_rat subroutine rat_eq_rat( rat1, rat2 ) implicit none type(rational),intent(out):: rat1 type(rational), intent(in) :: rat2 rat1%num =rat2%num rat1%denom = rat2%denom return end subroutine rat_eq_ratsubroutine int_eq_rat( int, rat ) implicit none integer, intent(out):: inttype(rational), intent(in) :: rat int = rat%num / rat%denom return end subroutine int_eq_rat subroutine real_eq_rat( float, rat ) implicit none real, intent(out) :: float type(rational), intent(in) :: rat float =real(rat%num) / real(rat%denom) return end subroutine real_eq_rat function reduse( a ) implicit none type(rational), intent(in) :: a integer :: b type(rational) :: reduse b=gcv_interface(a%num,a%denom) reduse%num = a%num/b reduse%denom = a%denom/b return end function reduse function gcv_interface(a,b) implicit none integer, intent(in) ::a,b integer :: gcv_interface if ( min(a,b) .eq. 0 ) then gcv_interface=1 return end if if (a==b) then gcv_interface=a return else if ( a>b ) then gcv_interface=gcv(a,b) else if ( a<b ) then gcv_interface=gcv(b,a) end if return end function gcv_interface recursive function gcv(a,b) result(ans) implicitnone integer, intent(in) :: a,b integer :: m integer :: ans m=mod(a,b) select case(m) case(0) ans=b return case(1) ans=1 return case default ans=gcv(b,m) end select return end function gcv function rat__rat_plus_rat( rat1, rat2 ) implicitnone 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, rat2 type(rational) :: temp temp%denom = rat1%denom*rat2%denom temp%num =rat1%num*rat2%denom - rat2%num*rat1%denom rat__rat_minus_rat = reduse( temp ) return end function rat__rat_minus_rat function rat__rat_times_rat( rat1,rat2 ) implicit none type(rational) :: rat__rat_times_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%denom temp%num = rat1%num * rat2%num rat__rat_times_rat = reduse(temp) return end function rat__rat_times_rat function rat__rat_div_rat( rat1, rat2 ) implicit none type(rational) ::rat__rat_div_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%num temp%num =rat1%num * rat2%denom rat__rat_div_rat = reduse(temp) return end function rat__rat_div_rat subroutine input(a) implicit none type(rational), intent(out) :: a write(*,*) "分子:" read(*,*) a%num write(*,*) "分母:" read(*,*) a%denom return end subroutine input subroutine output(a) implicit none type(rational), intent(in) :: a if ( a%denom/=1 ) then write(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom else write(*, "(I3)" ) a%num end if return end subroutine outputend 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,ca=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。

工程分析程序设计上机作业(五)模块化编程上机目的：掌握内部例程、主程序、外部例程、模块等功能的使用方法。

1、有一个六边形，求其面积。

为求面积，作了3条辅助线。

如图所示：(提示，三角形面* a b c积=s(s-a)(s-b)(s-c)，其中s ，a、b、c为三个边长)。

要求用内部函数来计算每个三角形的面积。

program mai nimplicit nonereal :: A(9)=(/10,30,16,13,21,14,20,36,28/)in teger ireal ss=area(A (3) ,A (4) ,A(7))+area(A(2),A(7),A(8))+ &area(A(1),A(8),A(9))+area(A (5),A (6) ,A(9))prin t*,'The area is',scontainsfunction area(x,y,z)implicit nonereal x,y,zreal p,areap=(x+y+z)/2area=sqrt(p*(p-x)*(p-y)*(p-z))end functionend2、编写一个子例程子程序，SUM(S , T , N1 , N2)。

把整型数N1到N2进行求和，并把求和的结果放置到S,把整型数N1到N2进行求积，并把求积的结果放置到T。

并用这个子程序来计算：y =(1 2 3 4) (3 4 5 6 7 8) (3*4*5*6) -(1*2*3)program mai nimplicit nonein teger A(8)in teger i,b,c,d,e,f,g,m, n,yb=O;d=O;g=1; n=1 do i=1,8A(i)=iend docall sum(b,c,1,4) call sum(d,e,3,8) call sum(f,g,3,6) call sum (m,n ,1,3)y=b+d+g-nprin t*,'y=(1+2+3+4)+(3+4+5+6+7+8)+(3*4*5*6)-(1*2*3)=',ycontainssubroutine sum(s,t,N1,N2) in teger s,t,N1,N2,i do i=N1,N2 s=s+A(i) t=t*A(i)end doend subrout ineend3、编写函数子程序GDC求两个数的最大公约数。

第四章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。

!习题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复习Fortran 复习题⽬类型：1、选择题2、填空题3、简答题4、编程题样题⼀、选择题1．下列名称中，符合FORTRAN 90命名规则的是。

A. a-b-cB. $123C. length_1D. date.year 2．关于FORTRAN 90程序单元，以下四种说法中正确的是。

A.⼀个FORTRAN 90程序由多个程序单元组成，其中有⼀个且只能有⼀个主程序单元B. ⼀个FORTRAN 90程序由多个程序单元组成，其中有⼀个且只能有⼀个模块单元C. ⼀个FORTRAN 90程序允许有多个程序单元，但每类程序单元只能有⼀个D. ⼀个FORTRAN 90程序允许有多个程序单元，但主程序单元和模块单元只能有⼀个3．关于FORTRAN 90的CASE结构，以下说法中正确的是。

A. CASE结构内必须取DEFAULT作为情况选择器的最终值结构的情况表达式不能是字符类型结构的情况表达式和情况选择器的取值类型必须相同结构的不同情况选择器取值可以重复4．已知数组说明REAL A(20:22,0:9,-3:-1)，数组A的数组元素个数是。

A．164 B．360 C．450 D．90 5．⼦程序的形式参数（虚拟变元或哑元）可以是。

A．变量名、数组名、过程名B．变量名、数组名、过程名和符号常量名C．变量名、数组名、数组⽚段、过程名D．任意符号名6. 语句OPEN（3，FILE=’ABC’，ACCESS=’DIRECT’，RECL=40）打开的是⽂件。

A．有格式顺序存取B．⽆格式顺序存取C．有格式直接存取D．⽆格式直接存取7、下列关于"SUBROUTINE MAP(X，Y)"语句⾏的叙述中，不正确的是( )A) 这是⼦程序的第⼀个语句 B) 字符串"MAP"是⼦程序名C) 变量X是⼦程序的形参D)⼦程序执⾏后，MAP将返回整型数据8、 FORTRAN表达式"2/4+0.5"的值是( )A) 0.5 B) 1 C) 1.0 D) 09、阅读下列FORTRAN程序：PI=3.14159265WRITE(*,'(F7.4) ')PIEND程序运⾏后输出结果是( )A) 3.142 B) 3.1415 C) 0.31416 D) 3.141610、圆的直径存放在整型变量K之中，下列计算圆⾯积的表达式中正确的是( )A) 3.1415926*K*K/4 B) 3.1415926*(K*K/4)C) 3.1415926*(K/2)**2 D) 3.1415926*(K/2)*(K/2)11、要判断"⽉收⼊M在2000元以上(含2000元)且5000元以下)不含5000元)"的职⼯，应该使⽤的逻辑表达式是( )A) M .GE. 2000 .AND. M .LE. 5000 B) M .GE. 2000 .OR. M .LE. 5000C) M .GE. 2000 .AND. M .LT. 5000 D) M .GE. 2000 .OR. M .LT. 500012、下列不是FORTRAN常量的是( )A) (3.0,4.0) B) 3.1416D+00 C) 2/3 D) 'Very good!'13、阅读下列FORTRAN程序：F=1.0DO 20 K=3, 7, 3DO 20 L=K-1, K20 WRTTE(*,'(I3, F8.1)'K, F*KEND程序运⾏结果的最后⼀⾏是( )A) 3 6.0 B) 6 6.0 C) 6 180.0 D) 7 180.014、在FORTRAN中，下列运算符的优先顺序是( )A) 逻辑运算，关系运算，算术运算 B) 关系运算，逻辑运算，算术运算C)算术运算，关系运算，逻辑运算 D) 关系运算，算术运算，逻辑运算15、使⽤FORTRAN内部函数时，所给的⾃变量( )A) 只能是常量 B) 只能是变量C) 只能是常量或者变量D)可以是常量、变量或者表达式16、设X=2.0, Y=8.0, Z=6.0, L=.TRUE.,则下列FORTRAN表达式中值为.TRUE.的是( )A) X+Z.GT.Y.AND.L B) .NOT.(Y.LT.Z+X).NEQV..NOT.LC) .NOT.L.OR.(L.EQV.Y+X.EQ.Z) D) Y+X.GE.Z+X.AND.(L.AND..FALSE.)17、下列输出语句⾏中正确的是( )A) WRITE(*，*)(A(K，L)，K=1，3，L=1，3)B) WRITE(*，*)A(K，L)，K=1，3，L=1，3C) WRITE(*，*)((A(K，L)，K=1，3)， L=1，3)D) WRITE(*，*)(A(K，L)，K=1，3)，L=1，318、给定下列FORTRAN⼦程序如下：SUBROUTINE SUB(K，A)A=SQRT(K*K+1.0)END下列调⽤语句中正确的是( )A) CALL SUB(N,N) B) CALL SUB(X,X)C) CALL SUB(N,X*X) D) CALL SUB(11,X)19、阅读下列FORTRAN程序:INTEGER AA(2,3)DATA AA/1,2,3,4,5,6/CALL S2D19(AA)CALL S2D19(AA(1,2))ENDSUBROUTINE S2D19(BB)INTEGER BB(2,2)WRITE(*,'(1X,2I3)') BB(1,1),BB(2,2)END程序运⾏结果是( )A) 1 4 B) 1 5 C) 1 4 D) 1 23 6 2 6 2 5 3 420、阅读下列FORTRAN程序:INTEGER A(3,3)DO 10 K=1,3DO 10 L=1,310 A(K,L)=K*10+LWRITE(*,'(1X,3I3)')AEND程序运⾏结果是: ( )A) 11 21 31 B) 11 12 13 C) 31 32 33 D) 33 32 3112 22 32 21 22 23 21 22 23 32 22 2113 23 33 31 32 33 11 12 13 31 21 11⼆、填空题1、下列FORTRAN函数⼦程序的功能是⽤以下公式计算⼀组数据Z1,Z2,…,Zn的标准差σ：σ2=(Z12 +Z22+…+Zn2)/n-[(Z1+Z2+…+Zn)/n]2请在程序中的下划线处填⼊合适的内容。

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的圆内。