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