第四章.programmainimplicitnonewrite(*,*)"Haveagoodtime."write(*,*)"That'snotbad."write(*,*)'"Mary"isn''tmyname.'grammainreal,parameter::PI=3implicitnone.14159realradiuswrite(*,*)"請輸入半徑長"read(*,*)radiuswrite(*,"('面積='f8.3)")radius*radius*PIgrammainimplicitnonerealgradeswrite(*,*)"請輸入成績"read(*,*)gradeswrite(*,"('調(diào)整后成績?yōu)?f8.3)")SQRT(grades)*10.0egera,brealra,rba=2b=3ra=2.0rb=3.0write(*,*)b/a!輸出1,因為使用整數(shù)計算,小數(shù)部分會無條件舍去write(*,*)rb/ra!輸出1.5.programmainimplicitnonetypedistancerealmeter,inch,cmendtypetype(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%inchendprogram第五章.programmainimplicitnoneintegermoneyrealtaxwrite(*,*)"請輸入月收入"read(*,*)moneyif(money<1000)thentax=0.03elseif(money<5000)thentax=0.1elsetax=0.15endifwrite(*,"('稅金為'I8)")nint(money*tax)grammainimplicitnoneintegerdaycharacter(len=20)::tvwrite(*,*)"請輸入星期幾"read(*,*)dayselectcase(day)case(1,4)tv="新聞"case(2,5)tv="電視劇"case(3,6)tv="卡通"case(7)tv="電影"casedefaultwrite(*,*)"錯誤的輸入"stopendselectwrite(*,*)grammainimplicitnoneintegerage,moneyrealtaxwrite(*,*)"請輸入年齡"read(*,*)agewrite(*,*)"請輸入月收入"read(*,*)moneyif(age<50)thenif(money<1000)thentax=0.03elseif(money<5000)thentax=0.10elsetax=0.15endifelseif(money<1000)thentax=0.5elseif(money<5000)thentax=0.7elsetax=0.10endifendifwrite(*,"('稅金為'I8)")nint(money*tax)grammainimplicitnoneintegeryear,dayslogicalmod_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)thendays=366elsedays=365endifwrite(*,"('這一年有'I3'天')")daysstopendprogram第六章programmainimplicitnoneintegeridoi=1,5write(*,*)"Fortran"enddostopendprogramprogrammainimplicitnoneintegeri,sumsum=0doi=1,99,2sum=sum+ienddowrite(*,*)sumstopendprogramprogrammainimplicitnoneinteger,parameter::answer=45integer,parameter::max=5integerweight,idoi=1,maxwrite(*,*)"請輸入體重"read(*,*)weightif(weight==answer)exitenddoif(i<=max)thenwrite(*,*)"猜對了"elsewrite(*,*)"猜錯了"endifstopendprogramprogrammainimplicitnoneinteger,parameter::max=10integerirealitemrealansans=1.0item=1.0doi=2,maxitem=item/real(i)ans=ans+itemenddowrite(*,*)ansstopendprogramprogrammainimplicitnoneinteger,parameter::length=79character(len=length)::input,outputintegeri,jwrite(*,*)"請輸入一個字串"read(*,"(A79)")inputj=1doi=1,len_trim(input)if(input(i:i)/='')thenoutput(j:j)=input(i:i)j=j+1endifenddowrite(*,"(A79)")outputstopendprogram第七章programmainimplicitnoneinteger,parameter::max=10integeriinteger::a(max)=(/(2*i,i=1,10)/)integer::t!sum()是fortran庫函數(shù)write(*,*)real(sum(a))/real(max)egera(5,5)!5*5=25integerb(2,3,4)!2*3*4=24integerc(3,4,5,6)!3*4*5*6=360integerd(-5:5)!11integere(-3:3,-3:3)!7*7=49programmainimplicitnoneinteger,parameter::max=10integerf(max)integerif(1)=0f(2)=1doi=3,maxf(i)=f(i-1)+f(i-2)enddowrite(*,"(10I4)")fstopendprogramprogrammainimplicitnoneinteger,parameter::size=10integer::a(size)=(/5,3,6,4,8,7,1,9,2,10/)integer::i,jinteger::tdoi=1,size-1doj=i+1,sizeif(a(i)<a(j))then!8(口跟a(j)交換t=a(i)a(i)=a(j)a(j)=tendifenddoenddowrite(*,"(10I4)")astopend5.a(2,2)!1+(2-1)+(2-1)*(5)=7a(3,3)!1+(3-1)+(3-1)*(5)=13第八章.programmainimplicitnonerealradius,areawrite(*,*)"請輸入半徑長"read(*,*)radiuscallCircleArea(radius,area)write(*,"('面積='F8.3)")areastopendprogramsubroutineCircleArea(radius,area)implicitnonereal,parameter::PI=3.14159realradius,areaarea=radius*radius*PIgrammainimplicitnonerealradiusreal,external::CircleAreawrite(*,*)"請輸入半徑長"read(*,*)radiuswrite(*,"('面積='F8.3)")CircleArea(radius)stopendprogramrealfunctionCircleArea(radius)implicitnonereal,parameter::PI=3.14159realradiusCircleArea=radius*radius*PIgrammainimplicitnonecallbar(3)callbar(10)stopendprogramsubroutinebar(length)implicitnoneinteger,intent(in)::lengthintegericharacter(len=79)::stringstring=""doi=1,lengthstring(i:i)='*'enddowrite(*,"(A79)")grammainimplicitnoneinteger,external::addwrite(*,*)add(100)endprogramrecursiveintegerfunctionadd(n)result(sum)implicitnoneinteger,intent(in)::nif(n<0)thensum=0returnelseif(n<=1)thensum=nreturnendifsum=n+add(n-1)grammainimplicitnoneinteger,external::gcdwrite(*,*)gcd(18,12)endprogramintegerfunctiongcd(A,B)implicitnoneintegerA,B,BIG,SMALL,TEMPBIG=max(A,B)SMALL=min(A,B)dowhile(SMALL/=1)TEMP=mod(BIG,SMALL)if(TEMP==0)exitBIG=SMALLSMALL=TEMPenddogcd=SMALLgrammainuseTextGraphLibimplicitnoneinteger,parameter::maxx=60,maxy=20real,parameter::StartX=0.0,EndX=3.14159*2.0real,parameter::xinc=(EndX-StartX)/(maxx-1)realxintegeri,px,pycallSetScreen(60,20)callSetCurrentChar('*')x=StartXdopx=1,maxxpy=(maxy/2)*sin(x)+maxy/2+1callPutChar(px,py)x=x+xincenddocallUpdateScreen()stopendprogram第九章1.programmainimplicitnonecharacter(len=79)::filenamecharacter(len=79)::bufferinteger,parameter::fileid=10integercountinteger::status=0logicalalivewrite(*,*)"Filename:"read(*,"(A79)")filenameinquire(file=filename,exist=alive)if(alive)thenopen(unit=fileid,file=filename,&access="sequential",status="old")count=0dowhile(.true.)read(unit=fileid,fmt="(A79)",iostat=status)bufferif(status/=0)exit!沒有資料就跳出循環(huán)write(*,"(A79)")buffercount=count+1if(count==24)thenpausecount=0endifenddoelsewrite(*,*)TRIM(filename),"doesn'texist."grammainimplicitnonecharacter(len=79)::filenamecharacter(len=79)::bufferinteger,parameter::fileid=10integeriinteger::status=0logicalalivewrite(*,*)"Filename:"read(*,"(A79)")filenameinquire(file=filename,exist=alive)if(alive)thenopen(unit=fileid,file=filename,&access="sequential",status="old")dowhile(.true.)read(unit=fileid,fmt="(A79)",iostat=status)bufferif(status/=0)exit!沒有資料就跳出循環(huán)doi=1,len_trim(buffer)buffer(i:i)=char(ichar(buffer(i:i))-3)enddowrite(*,"(A70)")bufferenddoelsewrite(*,*)TRIM(filename),"doesn'texist."grammainimplicitnonetypestudentintegerchinese,english,math,science,social,totalendtypetype(student)::s,totalinteger,parameter::students=20,subjects=5integeriopen(10,file="grades.bin",access="direct",recl=1)write(*,"(7A10)")"座號","中文","英文","數(shù)學(xué)","自然","社會","總分"total=student(0,0,0,0,0,0)doi=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,senddowrite(*,"(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)grammainimplicitnonecharacter(len=79)::filenamecharacter(len=79)::bufferinteger,parameter::fileid=10integeriinteger::status=0logicalalivewrite(*,*)"Filename:"read(*,"(A79)")filenameinquire(file=filename,exist=alive)if(alive)thenopen(unit=fileid,file=filename,&access="sequential",status="old")dowhile(.true.)read(unit=fileid,fmt="(A79)",iostat=status)bufferif(status/=0)exit!沒有數(shù)據(jù)就跳出循環(huán)doi=1,len_trim(buffer)buffer(i:i)=char(ichar(buffer(i:i))-(mod(i-1,3)+1))enddowrite(*,"(A70)")bufferenddoelsewrite(*,*)TRIM(filename),"doesn'texist."endifstopend5.moduletypedeftypestudentinteger::numinteger::Chinese,English,Math,Natural,Socialinteger::totalinteger::rankendtypeendmoduleprogrammainusetypedefimplicitnoneinteger,parameter::fileid=10integer,parameter::students=20character(len=80)::tempstrtype(student)::s(students)!儲存學(xué)生成績type(student)::total!計算平均分數(shù)用integeri,num,erroropen(fileid,file="grades.txt",status="old",iostat=error)if(error/=0)thenwrite(*,*)"Opengrades.txtfail."stopendifread(fileid,"(A80)")tempstr!讀入第一行文字total=student(0,0,0,0,0,0,0,0)!用循環(huán)讀入每位學(xué)生的成績doi=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!累加上各科的分數(shù),計算各科平均時使用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)%Totalenddocallsort(s,students)!重新輸出每位學(xué)生成績write(*,"(8A7)")"座號","中文","英文","數(shù)學(xué)","自然","社會","總分","名次"doi=1,studentswrite(*,"(8I7)")s(i)enddo!計算并輸出平均分數(shù)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)stopendprogramsubroutinesort(s,n)usetypedefimplicitnoneintegerntype(student)::s(n),tintegeri,jdoi=1,n-1doj=i+1,nif(s(i)%total<s(j)%total)thent=s(i)s(i)=s(j)s(j)=tendifenddoenddoforall(i=1:n)s(i)%rank=iendforallendsubroutine第十章1.integer(kind=4)::a!4bytesreal(kind=4)::b!4bytesreal(kind=8)::c!8bytescharacter(len=10)::str!10bytesinteger(kind=4),pointer::pa!4bytesreal(kind=4),pointer::pb!4bytesreal(kind=8),pointer::pc!4bytescharacter(len=10),pointer::pstr!4bytestypestudentintegerChinese,English,Mathendtypetype(student)::s!12bytestype(student),pointer::ps!4eger,target::a=1integer,target::b=2integer,target::c=3integer,pointer::pp=>awrite(*,*)p!1p=>bwrite(*,*)p!2p=>cp=5write(*,*)c!53.modulelinklisttypestudentinteger::numinteger::Chinese,English,Math,Science,Socialendtypetypedatalinktype(student)::itemtype(datalink),pointer::nextendtypecontainsfunctionSearchList(num,head)implicitnoneinteger::numtype(datalink),pointer::head,ptype(datalink),pointer::SearchListp=>headnullify(SearchList)dowhile(associated(p))if(p%item%num==num)thenSearchList=>preturnendifp=>p%nextenddoreturnendfunctionendmodulelinklistprogramex1016uselinklistimplicitnonecharacter(len=20)::filenamecharacter(len=80)::tempstrtype(datalink),pointer::headtype(datalink),pointer::ptype(student),allocatable::s(:)integeri,error,sizewrite(*,*)"filename:"read(*,*)filenameopen(10,file=filename,status="old",iostat=error)if(error/=0)thenwrite(*,*)"Openfilefail!"stopendifallocate(head)nullify(head%next)p=>headsize=0read(10,"(A80)")tempstr!讀入第一行字符串,不需要處理它!讀入每一位學(xué)生的成績dowhile(.true.)read(10,fmt=*,iostat=error)p%itemif(error/=0)exitsize=size+1allocate(p%next,stat=error)!新增下一個數(shù)據(jù)if(error/=0)thenwrite(*,*)"Outofmemory!"stopendifp=>p%next!移動到鏈表的下一個數(shù)據(jù)nullify(p%next)enddowrite(*,"('總共有',I3,'位學(xué)生')")sizeallocate(s(size))p=>headdoi=1,sizes(i)=p%itemp=>p%nextenddodowhile(.true.)

write(*,*)"要查詢幾號同學(xué)的成績?"read(*,*)iif(i<1.or.i>size)exit!輸入不合理的座號write(*,"(5(A6,I3))")"中文",s(i)%Chinese,&"英文",s(i)%English,&"數(shù)學(xué)",s(i)%Math,&"自然",s(i)%Science,&"社會",s(i)%Socialenddowrite(*,"('座號’,I3,'不存在,程序結(jié)束.')")istopendprogram4.moduletypedefimplicitnonetype::datalinkinteger::itype(datalink),pointer::nextendtypedatalinkendmoduletypedefprogramex1012usetypedefimplicitnonetype(datalink),pointer::p,head,nextinteger::i,n,errwrite(*,*)'InputN:'read(*,*)nallocate(head)head%i=1nullify(head%next)p=>headdoi=2,nallocate(p%next,stat=err)if(err/=0)thenwrite(*,*)'Outofmemory!'stopendifp=>p%nextp%i=ienddonullify(p%next)p=>headdowhile(associated(p))write(*,"(i5)")p%ip=>p%nextenddo!釋放鏈表的存儲空間p=>headdowhile(associated(p))next=>p%nextdeallocate(p)p=>nextenddostopendprogram第十一章.moduleutilityimplicitnoneinterfaceareamoduleprocedureCircleAreamoduleprocedureRectAreaendinterfacecontainsrealfunctionCircleArea(r)real,parameter::PI=3.14159realrCircleArea=r*r*PIreturnendfunctionrealfunctionRectArea(a,b)reala,bRectArea=a*breturnendfunctionendmoduleprogrammainuseUTILITYimplicitnonewrite(*,*)area(1.0)write(*,*)area(2.0,3.0)stopendprogram.moduletime_utilityimplicitnonetype::timeinteger::hour,minute,secondendtypetimeinterfaceoperator(+)moduleprocedureadd_time_timeendinterfacecontainsfunctionadd_time_time(a,b)implicitnonetype(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+carryreturnendfunctionadd_time_timesubroutineinput(a)implicitnonetype(time),intent(out)::awrite(*,*)"Inputhours:"read(*,*)a%hourwrite(*,*)"Inputminutes:"read(*,*)a%minutewrite(*,*)"Inputseconds:"read(*,*)a%secondreturnendsubroutineinputsubroutineoutput(a)implicitnonetype(time),intent(in)::awrite(*,"(I3,'hours',I3,'minutes',I3,'seconds')")a%hour,a%minute,a%secondreturnendsubroutineoutputendmoduletime_utilityprogrammainusetime_utilityimplicitnonetype(time)::a,b,ccallinput(a)callinput(b)c=a+bcalloutput(c)stopendprogrammain3.modulerational_utilityimplicitnoneprivatepublic::rational,&operator(+),operator(-),operator(*),&operator(<),operator(==),operator(/=),&integer::num,denomendtyperationaloperator(/),assignment(=),operator(>),&rat__rat_plus_ratrat__rat_minus_ratrat__rat_times_ratendinterfaceendinterfaceendinterfaceoutput,input3.modulerational_utilityimplicitnoneprivatepublic::rational,&operator(+),operator(-),operator(*),&operator(<),operator(==),operator(/=),&integer::num,denomendtyperationaloperator(/),assignment(=),operator(>),&rat__rat_plus_ratrat__rat_minus_ratrat__rat_times_ratendinterfaceendinterfaceendinterfaceoutput,input

interfaceoperator(+)

interfaceoperator(-)

interfaceoperator(*)

interfaceoperator(/)type::rationalmodulemodulemodulemoduleprocedureprocedureprocedureprocedurerat__rat_div_ratendinterfaceinterfaceassignment(=)moduleprocedurerat_eq_ratmoduleprocedureint_eq_ratmoduleprocedurereal_eq_ratendinterfaceinterfaceoperator(>)moduleprocedurerat_gt_ratendinterfaceinterfaceoperator(<)moduleprocedurerat_lt_ratendinterfaceinterfaceoperator(==)moduleprocedurerat_compare_ratendinterfaceinterfaceoperator(/=)moduleprocedurerat_ne_ratendinterfacecontainsfunctionrat_gt_rat(a,b)implicitnonelogical::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.endifreturnendfunctionrat_gt_ratfunctionrat_lt_rat(a,b)implicitnonelogical::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.endifreturnendfunctionrat_lt_ratfunctionrat_compare_rat(a,b)implicitnonelogical::rat_compare_rattype(rational),intent(in)::a,btype(rational)::cc=a-bif(c%num==0)thenrat_compare_rat=.true.elserat_compare_rat=.false.endifreturnendfunctionrat_compare_ratfunctionrat_ne_rat(a,b)implicitnonelogical::rat_ne_rattype(rational),intent(in)::a,btype(rational)::cc=a-bif(c%num==0)thenrat_ne_rat=.false.elserat_ne_rat=.true.endifreturnendfunctionrat_ne_ratsubroutinerat_eq_rat(rat1,rat2)implicitnonetype(rational),intent(out)::rat1type(rational),intent(in)::rat2rat1%num=rat2%numrat1%denom=rat2%denomreturnendsubroutinerat_eq_ratsubroutineint_eq_rat(int,rat)implicitnoneinteger,intent(out)::inttype(rational),intent(in)::ratint=rat%num/rat%denomreturnendsubroutineint_eq_ratsubroutinereal_eq_rat(float,rat)implicitnonereal,intent(out)::floattype(rational),intent(in)::ratfloat=real(rat%num)/real(rat%denom)returnendsubroutinereal_eq_ratfunctionreduse(a)implicitnonetype(rational),intent(in)::ainteger::btype(rational)::reduseb=gcv_interface(a%num,a%denom)reduse%num=a%num/breduse%denom=a%denom/breturnendfunctionredusefunctiongcv_interface(a,b)implicitnoneinteger,intent(in)::a,binteger::gcv_interfaceif(min(a,b).eq.0)thengcv_interface=1returnendifif(a==b)thengcv_interface=areturnelseif(a>b)thengcv_interface=gcv(a,b)elseif(a<b)thengcv_interface=gcv(b,a)endifreturnendfunctiongcv_interfacerecursivefunctiongcv(a,b)result(ans)implicitnoneinteger,intent(in)::a,binteger::minteger::ansm=mod(a,b)selectcase(m)case(0)ans=breturncase(1)ans=1returncasedefaultans=gcv(b,m)endselectreturnendfunctiongcvfunctionrat__rat_plus_rat(rat1,rat2)implicitnonetype(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%denomrat__rat_plus_rat=reduse(act)returnendfunctionrat__rat_plus_ratfunctionrat__rat_minus_rat(rat1,rat2)implicitnonetype(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%denomrat__rat_minus_rat=reduse(temp)returnendfunctionrat__rat_minus_ratfunctionrat__rat_times_rat(rat1,rat2)implicitnonetype(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)returnendfunctionrat__rat_times_ratfunctionrat__rat_div_rat(rat1,rat2)implicitnonetype(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)returnendfunctionrat__rat_div_ratsubroutineinput(a)implicitnonety