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

上海师范大学FORTRAN 大作业题目：钢筋混凝土偏心受压柱配筋设计专业土木工程学号姓名指导老师完成日期2015年11月我们组解决的问题是利用不对称配筋矩形截面偏心受压构件承载力的计算方法在已知某些条件时求矩形截面纵向钢筋的截面面积。

小偏心受压简介：小偏压破坏是由受压区混凝土的压碎所引起的。

破坏时，压应力较大一侧的受压钢筋的压应力一般都能达到屈服强度，而另一侧的钢筋不论受拉还是受压，其应力一般都达不到屈服强度。

构件在破坏之前变形不会急剧增长，但受压区垂直裂缝不断发展，破坏时没有明显预兆，属脆性破坏，也称受压破坏。

已知条件：1.截面尺寸b*h2.构建计算长度l03.混凝土强度等级fc4.钢筋种类及强度fy，fy25.柱端弯矩设计值M1，M2及其相应轴向力设计值N6.受压侧钢筋面积As1。

求：钢筋截面面积As。

其中涉及到：1.混凝土受压区高度调整系数a1的给定2.界限相对受压区刚度Eb 的给定3.受压侧钢筋面积As1的给定4.矩形截面的有效高度h0的计算5.回转半径的计算6.初始偏心距ei，附加偏心距ea的计算7.偏心距调整系数Cm的计算8.偏心受压构件界面曲率修正系数Ec 的计算9.弯矩增大系数Nns 的计算10.设计弯矩M的计算11.大小偏心受压的判别12.两侧钢筋面积As1，As2的计算13.截面单侧钢筋配筋率的验算14.全截面配筋率的验算下面以一道例题来具体说明。

已知一偏心受压柱b*h=450*500，as1-as2=40mm，柱计算高度l0=4m，作用在柱上的荷载设计值所产生的内力N=2200KN，两端弯矩为M1=M2=200KN*m，受压侧钢筋面积As1=1320As+As1)/A<0.05As+As1)/A<0.05As+As1)/A<0.05As+As1)/A<0.05As+As1)/ A<0.05As+As1)/A<0.05As+As1)/A<0.05mm**2。

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

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程序设计习题答案第四章 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。

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