(完整word版)fortran程序实例
fortran程序案例题汇编(14道)-推荐下载
t=.false. exit endif enddo prime=t end
1
对全部高中资料试卷电气设备，在安装过程中以及安装结束后进行高中资料试卷调整试验；通电检查所有设备高中资料电试力卷保相护互装作置用调与试相技互术关，系电通，力1根保过据护管生高线产中0不工资仅艺料可高试以中卷解资配决料置吊试技顶卷术层要是配求指置，机不对组规电在范气进高设行中备继资进电料行保试空护卷载高问与中题带资2负料2，荷试而下卷且高总可中体保资配障料置2试时32卷，3各调需类控要管试在路验最习；大题对限到设度位备内。进来在行确管调保路整机敷使组设其高过在中程正资1常料中工试，况卷要下安加与全强过，看度并25工且52作尽22下可护都能1关可地于以缩管正小路常故高工障中作高资；中料对资试于料卷继试连电卷接保破管护坏口进范处行围理整，高核或中对者资定对料值某试，些卷审异弯核常扁与高度校中固对资定图料盒纸试位，卷置编工.写况保复进护杂行层设自防备动腐与处跨装理接置，地高尤线中其弯资要曲料避半试免径卷错标调误高试高等方中，案资要，料求编试技5写、卷术重电保交要气护底设设装。备备置管4高调、动线中试电作敷资高气，设料中课并技3试资件且、术卷料中拒管试试调绝路包验卷试动敷含方技作设线案术，技槽以来术、及避管系免架统不等启必多动要项方高方案中式；资，对料为整试解套卷决启突高动然中过停语程机文中。电高因气中此课资，件料电中试力管卷高壁电中薄气资、设料接备试口进卷不行保严调护等试装问工置题作调，并试合且技理进术利行，用过要管关求线运电敷行力设高保技中护术资装。料置线试做缆卷到敷技准设术确原指灵则导活：。。在对对分于于线调差盒试动处过保，程护当中装不高置同中高电资中压料资回试料路卷试交技卷叉术调时问试，题技应，术采作是用为指金调发属试电隔人机板员一进，变行需压隔要器开在组处事在理前发；掌生同握内一图部线纸故槽资障内料时，、，强设需电备要回制进路造行须厂外同家部时出电切具源断高高习中中题资资电料料源试试，卷卷线试切缆验除敷报从设告而完与采毕相用，关高要技中进术资行资料检料试查，卷和并主检且要测了保处解护理现装。场置设。备高中资料试卷布置情况与有关高中资料试卷电气系统接线等情况，然后根据规范与规程规定，制定设备调试高中资料试卷方案。
(完整word版)fortran程序实例
1) 实例3 —求多个半径下的圆周长 ! z3.f90 --Fortran95 FUNCTIONS:-Entry point of con sole application.I*************************************************************************PROGRAM: z3PURPOSE: En try point for the con sole applicati on.I************************************************************************program z3 !求多个半径下的圆周长 !主程序! PROGRAM Z3PRINT *, 'R=',1.2,'C=',C(1.2) PRINT *, 'R=',3.4,'C=',C(3.4) PRINT *, 'R=',15.6,'C=',C(15.6) PRINT *, 'R=',567.3,'C=',C(567.3) END program z3 !子程序FUNCTION C(R) PI=3.1415926 C=2*PI*R RETURN ! Body of z3 endz3•■Alta• JSwFta.■■ TTjn* FMIIH-.T jd - |叭■(Lld4ilh■ Hi li tii.IW M H MvfriiMfeai Iwi Ji JJII+M4Tml+n««I*界rFHtlE- HfrtpliK * W mita itflLuLfl-PRINT* ,'以上为计算机的计算结果，注意 B 的值'ZXZ I O.f90 FUNCTIONS: ZXZ_I_O- Entry point of con sole applicati on.PROGRAM: ZXZ_I_OPURPOSE: En try point for the con sole applicati on.program ZXZ_I_O implicit none!变量声明的位置INTEGER(2) i; INTEGER(4) j; INTEGER(4) m; REAL n INTEGER A,B PRINT*,'输入整数 A'; READ*, A PRINT*,'输入整数 B'; READ*, B B=A+BWRITE(*,*) 'A*B=',A*B实例4 —键盘与显示器输入/输出2)a) Fortra n 基本操作1 B Li PlLu- i \ JfiL ■ I■' hi -IJBL . n ：»'匹："b ）程序指令BIE1A J~. C ■* «I*************** 输入、输出样式种种 **************************!系统默认的输出样式 PRINT* ,'系统默认的输出样式' !人为控制的的输出样式--格式化输出 i=21; j=53; m=5 n=(i+j*m*i**m) WRITE(*,*) 'i,j,m 是常量，程序赋初值PRINT*, i,j,m WRITE(*,*) 'i,j,m 的计算结果：'PRINT*,'i+j*m*i**m=' ,nPRINT* ,''! Body of ZXZ_I_O end program ZXZ_I_O 程序说明： 程序赋值一初始化 i=21; j=53; m=5 键盘无格式输入 READ*, A 键盘有格式输入 READ ( *, 100)A,B,C 100 FORMA T( 2F5.2,F5.3) 显示器无格式输出PRINT* ,'系统默认的输出样式' WRITE(*,*) 'A*B=',A*B 显示器有格式输出 PRINT 100 ,A+B WRITE(*,100) 'A*B=',A*B 100 FORMA T( F5.2)C ）调试运行d ）程序指令pruqrdiri ZX2_l_0 iflnpllclt iioiiv 陝量声明的立置IHTEGERfZ) i; IMTEGEimi ]； IHTEGER(^)叭 REAL nA.B I Uairidbles■HIKE J 播入整該■打1E.D 屯A PRINT •，-KM«a■ e-fltBFHJHIv T -H-Ai-B-1 ,ti' Axb- 1 T A I UHU NA 「臥存为计負机药计貝韭呆*妊憲L1的低・1-21; j-b3;«R[TEC-,«) l,j,n 是常最.程序Itt 前值・FHIHTa, 1 J ,■WR1TF(-F -J l p j,n 的tt 幣结黑,.FHim* /■r u 讪o#畑」」Ffirl prnni'an ZK? I o! ZXZ丄O.f90! FUNCTIONS:ZXZ_I_O - Entry point of con sole applicati on.PROGRAM: ZXZ_I_OPURPOSE: En try point for the con sole applicati on.1 *************** 输^入 ^输出样式种不中program ZXZ_I_Oimplicit none!变量声明的位置INTEGER(2) i; INTEGER(4) j; INTEGER(4) m; REAL nINTEGER A,BREAL X,Y ,Z ! VariablesPRINT*,'输入整数A'; READ*, APRINT*,'输入整数B'; READ*, B PRINT*,'计算结果为：'B=A+BPRINT*,'B=A+B=',BWRITE(*,*) 'A*B=',A*BPRINT* ,'以上为计算机的计算结果，注意B的值'!系统默认的输出样式PRINT* ,'系统默认的输出样式'PRINT*,'输入实数X'; READ(*,100) XPRINT*,'输入实数Y：READ(*,100) Y100 FORMA T(F5.2)PRINT*,'计算结果为：'Z=X+YPRINT 200,Z200 FORMA T(4X,'Z=X+Y=',F8.3)WRITE(*,*)WRITE(*,300) X*Y300 FORMA T(4X,'Z=X*Y=',F8.3)!人为控制的的输出样式--格式化输出PRINT* ,'程序为常量赋了初值'i=21; j=53; m=5n=(i+j*m*i**m)WRITE(*,*) 'i,j,m 是常量，程序赋初值PRINT*, i,j,mWRITE(*,*) 'i,j,m 的计算结果：'PRINT*,'i+j*m*i**m=' ,nPRINT* ,' '! Body of ZXZ_I_Oend program ZXZ_I_Oe)调试运行rRIHT* JPRTNi*. ■讦薛结果为.・ E^A*BPRTNT*,,R=A+R=,,8 URrfEfw,*) 'ft-D-1t A-DPRINT * J 以上药i1■宴利的iT 畀结果.傢金默认囱馥出择畫PRINT*「系唏默认册葆出样式・ 阳IHH. •揃扎斓 W ： WIHZJ 输入宪数V;1B0 F0RHAKF5.2)PRINT -，■廿尊结杲为FREAD(*,1ua ) K R 匚flD(*,100) VPRINT 2Q0左2(JU FUKMfil(4i(t ； = «+/= \FB »J) unrrEf*.*)WRITE(*r 30O) X*V FORMfiT(UX /? = X*V=* ,F8 .3}认为扌前函的输世#戎一逼占化输出PRTHT- ”囉序対常豊瓯了初值・ i^Z» i j=53;I1=5 n=(i +j*m*i**n)WRITEf"^) 'i t j t n 是常量，程序赋初值 PRTHTw, i r j F nMRlTEe 』)・i J,n 的计具结衆：，PRI HI*.'i+j *R*i**m=',n。
FORTRAN编程演示
2-4 输入输出语句 PRINT语句是Fortran中较为常用的一种输 出语句，用它来完成表控输出的语法格式如 下所示。 PRINT *[, 输出项,……] 在PRINT语句中不能指定输出设备，只能向 系统隐含指定的设备输出数据（隐含指定的 输出设备一般是指计算机屏幕）；语句中的 星号“*”表示“表控格式输出”，即按照 计算机默认的格式进行数据的输出；输出项 可以有多个，每个输出项之间用逗号“,”分 隔；当语句中没有输出项时，命令将输出一 个空白行。
输入语句 使用READ语句来完成表控输入的语法形式 如下所示。 READ *[, 输入项,……] 在这种形式中，不能指定输入设备，只能由 系统隐含指定的设备上输入（系统隐含指定 的设备一般是指键盘）；语句中的星号“*” 表示“表控输入”，即按照数据合法的格式 进行输入；输入项可以有多个，每个输出项 之间用逗号“,”分隔；当语句中没有输入项 时，系统将挂起程序的运行直到用户键入回 车符。
2.编写程序已知园半径分别为1、3、12时，对应的 园周长为多少？ 示例4
C MAIN PROGEAM ！注释下面为主程序 PROGRAM EX2 PRINT *,“R=”,1.0,“C=”,C(1.0) ！显示半径周长 PRINT *,"R=",3.0,"C=",C(3.0) PRINT *,“R=”,12.0,“C=”,C(12.0) ！未解释C END C SUBPROGRAM ！下面为子程序 FUNCTION C(R) ！C(R) 是一个函数名字 PI=3.1415926 C=2*PI*R RETURN END ！编写了函数的内容
示范举例1。
2- 2 编程修改程序
FORTRAN90程序设计1[1]
![FORTRAN90程序设计1[1]](https://img.taocdn.com/s3/m/4d51e420bcd126fff7050be5.png)
程序设计举例
算法
算法是计算机软件中的一个基本概念，它是对解决实际问题的方法和步
骤的描述。设计算法是程序设计的核心，也是编写程序的基础。
正确的算法有以下几个显著特点：
(1)有穷性(flniteness)。 (2)确定性(certainty)。 (3)有效性(effcctivencss)。 (4)有零个或多个输入(input)。 (5)有一个或多个输出(output)。
简单的FORTRAN90程序分析
（6）空格并不是随处都可以使用的，一个像关键字、变量和常量名以 及操作符等的字符，其内部是不能使用空格的，空格会使字符失去其原 有的含义。 （7）FORTRAN90的注释语句是以感叹号为标志的，一行中感叹号后的 所有字符都被编译器作为注释语句而忽略。注释语句可以单独占一行， 也可在程序的其他语句后面出现。在FORTRAN90中，空行被作为注释 语句。 （8）如果遇到一条语句的长度超过了FORTRAN90所允许的行最大长度， 需要写成几行，FORTRAN90提供了一个续行符 ( & ) ，通过在语句末尾 添加续行符，编译器就会把下一行作为续行来处理。如果是把一个如关 键字这样的字符分成两行，那么需要在下行语句的开头再加一个续行符。
CHARACTER ( LEN = 10 ) :: STRING 子字符串是字符串中的若干个连续字符的集合。子字符
CHARACTER (LEN = 5 ) :: SUBSTRING 串的表示方法如下： CHARACTER (LEN = 1 ) :: CHAR STRING=’JANEJORDE’ 字符串变量名（[FIRST-POSITION] : [END-POSITION]） ! SUBSTRING的值为“JANE” SUBSTRING=STRING ( :5 ) 缺省的开始位置是１，缺省的结束位置是字符串的长度。 SUBSTRING=STRING ( 5:6 ) ! SUBSTRING的值为“J” 如果开始位置大于结束位置则子字符串为空，即它的长 SUBSTRING=STRING ( 3:7 ) ! SUBSTRING的值为“NEJO” N=7 度为０。 CHAR=’ABCDEFGHIJK’ ( N:N ) ! CHAR的值为“G”
Fortran95程序设计课后习题答案(word版方便)
第四章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。
fortran常用程序
fortran常用程序----------------------- Page 1----------------------- Fortran 简单程序集杨洋1!大小写转换program ex39implicit nonecharacter*20 strinteger iprint*,'input the string:'read*,strdo i=1,len_trim(str)if(str(i:i)>='a'.and.str(i:i)<='z') str(i:i)=char(ichar(str(i:i))-32) end doprint*,'the inverted string:'print*,strend!将字符串转化为整数program ex104implicit noneexternal fcharacter*10 strinteger fprint*,'输入由数字组成的字符串:'read*,strprint*,'转化后的整数:'print*,f(str)endfunction f(str)implicit nonecharacter*(*) strinteger f,k,if=0k=len_trim(str)do i=1,kf=f+(ichar(str(i:i))-ichar('0'))*10**(k-i)end doend function!将十进制数转化为二进制数（用字符串保存）program ex1101 作者简介：杨洋，南京信息工程大学大气科学学院海洋科学系2008 级1----------------------- Page 2-----------------------program ex110implicit noneinteger acharacter*8::b=' 'print*,'输入一个十进制整数:'read*,ado while(a>0)if (mod(a,2)==1) thenb='1'//belseb='0'//bend ifa=a/2end doprint*,'对应的二进制数为:'print*,bend!将二进制数（用字符串保存）转化为十进制数program ex111implicit nonecharacter*8 ainteger::b=0,k,iprint*,'输入一个二进制数:'read*,ak=len_trim(a)do i=1,kb=b+(ichar(a(i:i))-ichar('0'))*2**(k-i)end doprint*,'对应的十进制数为:'print*,bend!统计大写、小写、数字及其他字符的个数program ex51implicit nonecharacter*20 strinteger::i,n1=0,n2=0,n3=0,n4=0print*,'输入字符串:'read*,strdo i=1,len_trim(str)select case(str(i:i))case('a':'z')n1=n1+12----------------------- Page 3-----------------------case('A':'Z')n2=n2+1case('0':'9')n3=n3+1case defaultn4=n4+1end selectend doprint*,’大写字母个数:’,n1print*,’小写字母个数:’,n2print*,’数字个数:’,n3print*,’其他字符个数:’,n4End!判断闰年program ex24implicit noneinteger yearprint*,'input a year:'read*,yeark=k+1work(k)=num(i)end ifend docall sort(work,k)print*,'the final array:'8----------------------- Page 9-----------------------print*,(work(i),i=1,k)endfunction prime(n)implicit noneinteger i,k,nlogical primek=sqrt(real(n))do i=2,kif (mod(n,i)==0) exitend doif (i>k) thenprime=.true.elseprime=.false.end ifend functionsubroutine sort(a,n)implicit noneinteger i,j,k,n,a(n),tdo i=1,n-1k=ido j=i+1,nif (a(j)>a(k)) k=jend doif (k/=i) thent=a(k)a(k)=a(i)a(i)=tend ifend doend subroutine! 求2～999 中同时满足下列条件的数：(a) 该数各位数字之和为奇数；(b) 该数是素数。
Fortran计算实例word版本
If(dt.le.1.e-9) then输出”dt太小”并goto 888
goto 999
888 close(10) End
停止运算的 无量纲时间
Subroutine output(tim,d1,u1,t1)
…..
If(tim.eq.0)open(10,…..form=‘unformatted’)
write(10)d,u,t Return end
v u v v v T T 0 t x y y y
T u T v T ( 1)T u ( 1)T v 0
t x y
x
y
2维流体力学方程组，*号已略去
u u 0
t x x
d1 (1)= d (1)
u1(1)= u (1)
t1(1)= t (1)
d1 (im)= d (im)
主
u1(im)= u (im)
体
t1(im)= t (im)
部
tim=tim+dt
分
dt=1.d0
do 60 i=2,im-1
固定边界条件
局地无量 纲声速
由柯朗条件定 下一时间步长
60
dt=dmin1(dt,dx/(dsqrt(gamma*t1(i))+dabs(u1(i)))
u u u T T 0 t x x x
T u T ( 1)T u 0
t x
x
对1D情况
3. 确定解域、划分网格及设置边界条件
可划分为上 千个格点
1
模拟区域： 网 格：
0
1 x 1 x(i) 2(i 1) /(N 1) 1
fortran95第七章例题程序
0701一维数组program mainimplicit noneinteger,parameter::students=5integer::student(students)integer i!录入学生成绩do i=1,studentswrite(*,"('number',I2)")iread(*,*)student(i)end do!提取学生成绩，并规定读取范围do while(.true.)write(*,*)"Query"read(*,*)iif(i<=0 .or. i>students) exitwrite(*,*)student(i)end dostopend0702program mainimplicit noneinteger::student1,student2,student3,student4,student5 integer i!录入数据write(*,*)'number1'read(*,*)student1write(*,*)'number2'read(*,*)student2write(*,*)'number3'read(*,*)student3write(*,*)'number4'read(*,*)student4write(*,*)'number5'read(*,*)student5!提取数据do while(.true.)write(*,*)'Query'read(*,*)iselect case(i)case(1)write(*,*)student1case(2)write(*,*)student2case(3)write(*,*)student3case(4)write(*,*)student4case(5)write(*,*)student5case defaultexitend selectend dostopend0703二维数组program mainimplicit noneinteger,parameter::classes=5integer,parameter::students=5 integer::student(students,classes)integer sinteger cdo c=1,classesdo s=1,studentswrite(*,"('Number',I2,'of class',I2)")s,c read(*,*)student(s,c)end doend dodo while(.true.)write(*,*)'class:'read(*,*)cif (c<=0 .or. c>classes) exitwrite(*,*)'student:'read(*,*)sif(s<=0 .or. s>students) exitwrite(*,"('score',I3)")student(s,c)end dostopend!s,c不能超过声明大小，否则程序会出错0704program mainimplicit noneinteger,parameter::row=2integer,parameter::col=2integer::matrixA(row,col)integer::matrixB(row,col)integer::matrixC(row,col)integer rinteger c!读入A矩阵的内容write(*,*)'Matrix A'do r=1,rowdo c=1,colwrite(*,"('A(',I1,',',I1,')=')")r,cwrite(*,*)'Matrix B'do r=1,rowdo c=1,colwrite(*,"('B(',I1,',',I1,')=')")r,cread(*,*)matrixB(r,c) !录入，记录数据end doend do!A+Bwrite(*,*)'Matrix A+B='do r=1,rowdo c=1,colmatrixC(r,c)=matrixA(r,c)+matrixB(r,c) write(*,"('(',I1,',',I1,')=',I3)")r,c,matrixC(r,c) end doend dostopend0705program ex0705implicit noneinteger, parameter :: row = 2integer, parameter :: col = 2integer :: matrix(row, col, 3)integer minteger rinteger cdo m=1, 2write(*,"('Matrix ',I1)") mdo r=1, rowdo c=1, colwrite(*,"('(',I1,',',I1,')=')") r,cread(*,*) matrix(r,c,m)end doend doend dowrite(*,*) "Matrix 1 + Matrix 2 = "do r=1, rowdo c=1, colmatrix(r,c,3) = matrix(r,c,1)+matrix(r,c,2)write(*,"('(',I1,',',I1,')=',I3)") r,c,matrix(r,c,3) end doend dostopend0706program mainimplicit noneinteger,parameter::students=5integer::student(students)=(/80,90,85,75,95/) integer ido while(.true.)write(*,*)'Query:'read(*,*)i !读入学生序号if (i<=0.or.i>students) exitwrite(*,*)student(i) !写出学生成绩end dostopend0707program mainimplicit noneinteger,parameter::row=2integer,parameter::col=2integer::m(row,col)integer rinteger cdata((m(r,c),r=1,2),c=1,2)/1,2,3,4/write(*,"(I3,I3,/,I3,I3)")((m(r,c),c=1,2),r=1,2) stopend0708program ex0708implicit noneinteger, parameter :: row = 2integer, parameter :: col = 2integer :: ma(row, col) = 1integer :: mb(row, col) = 4integer :: mc(row, col)integer :: i,jmc = ma + mbwrite(*,"(I3,I3,/,I3,I3)") ((mc(i,j), i=1,2),j=1,2)stopend0709program ex0709implicit noneinteger, parameter :: row = 2integer, parameter :: col = 2integer :: a(2,2)=(/ 1,2,3,4 /)! a(1,1)=1, a(2,1)=2, a(1,2)=3, a(2,2)=4 integer :: b(4)=(/ 5,6,7,8 /)integer :: c(2)write(*,*) a ! a(1,1), a(2,1), a(1,2), a(2,2) write(*,*) a(:,1) ! a(1,1), a(1,2)c = a(:,1) ! c(1)=a(1,1), c(2)=a(2,1)write(*,*) c ! c(1), c(2)c = a(2,:) ! c(1)=a(2,1), c(2)=a(2,2)write(*,*) c ! c(1), c(2)write(*,*) c(2:1:-1) ! c(2), c(1)c = b(1:4:2) ! c(1)=b(1), c(2)=b(3)write(*,*) c ! c(1), c(2)stopend0710program ex0710implicit noneinteger :: iinteger :: a(5)=(/ (i,i=1,5) /) integer :: b(5)=0!把b中小于3的元素赋值给a where( a<3 )b = aend wherewrite(*,"(5(I3,1X))") bstopendprogram mainimplicit noneinteger::iinteger::a(5)=(/1,2,3,4,5/) integer::b(5)=0where(a<3) b=awrite(*,"(5(I3,1x))")bstopend0711program ex0711implicit noneinteger :: iinteger :: a(5)=(/ (i,i=1,5) /) integer :: b(5)=0where( a<3 )b = 1elsewhereb = 2end wherewrite(*,"(5(I3,1X))") bstopend0712program ex0712implicit noneinteger :: ireal :: income(10)=(/ 250000, 300000, 500000, 400000, 350000, &600000, 270000, 450000, 280000, 700000 /) real :: tex(10)=0where( income < 300000.0 )tex = income*0.10elsewhere( income < 500000.0 )tex = income*0.12elsewheretex = income*0.15end wherewrite(*,"(10(F8.1,1X))") texstopend0713program ex0713implicit noneinteger iinteger :: a(5)forall(i=1:5)a(i)=5end forall! a(1)=a(2)=a(3)=a(4)=a(5)=5write(*,*) aforall(i=1:5)a(i)=iend forall! a(1)=1, a(2)=2, a(3)=3, a(4)=4, a(5)=5write(*,*) astopend0714program ex0714implicit noneinteger I,Jinteger, parameter :: size = 5integer :: a(size,size)forall ( I=1:size, J=1:size, I>J ) a(I,J)=1 forall ( I=1:size, J=1:size, I==J ) a(I,J)=2 forall ( I=1:size, J=1:size, I<J ) a(I,J)=3write(*,"(5(5I5,/))") astopend0715program ex0715implicit noneinteger, parameter :: max = 1000 integer :: a(max)integer :: studentsinteger :: iwrite(*,*) "How many students:"read(*,*) studentsdo i=1,studentswrite(*,"('Number ',I3)") iread(*,*) a(i)end dostopend0716program ex0716implicit noneinteger :: studentsinteger, allocatable :: a(:)integer :: iwrite(*,*) "How many students:"read(*,*) studentsallocate( a(students) )do i=1,studentswrite(*,"('Number ',I3)") iread(*,*) a(i)end dostopend0717program ex0717implicit noneinteger :: size, error=0integer, parameter :: one_mb=1024*1024 character, allocatable :: a(:)do while( .true. )size=size+one_mballocate( a(size), stat=error )if ( error/=0 ) exitwrite(*,"('Allocate ',I10, ' bytes')") sizewrite(*,"(F10.2,' MB used')") real(size)/real(one_mb) deallocate( a )end dostopend0718program ex0718implicit noneinteger, parameter :: size=10integer :: a(size) = (/ 5,3,6,4,8,7,1,9,2,10 /)integer :: i,jinteger :: tdo i=1, size-1do j=i+1, sizeif ( a(i) > a(j) ) thent=a(i)a(i)=a(j)a(j)=tend ifend doend dowrite(*,"(10I4)") astopend0719program ex0719implicit noneinteger, parameter :: L=3, M=4, N=2real :: A(L,M) = (/ 1,2,3,4,5,6,7,8,9,10,11,12 /) real :: B(M,N) = (/ 1,2,3,4,5,6,7,8 /)real :: C(L,N)integer :: i,j,kdo i=1,Ldo j=1,NC(i,j) = 0.0do k=1,MC(i,j) = C(i,j)+A(i,k)*B(k,j)end doend doend dodo i=1,Lwrite(*,*) C(i,:)end dostopend。
有限元编程算例(fortran)【范本模板】
有限元编程算例（Fortran）本程序通过Fortran语言编写，程序在Intel Parallel Studio XE 2013 with VS2013中成功运行，程序为《计算力学》（龙述尧等编)一书中的源程序，仅作研究学习使用，省去了敲写的麻烦.源程序为：！Page149COMMON/X1/NJ，NE，NZ，NDD，NPJ，IND,NJ2,EO，UN,GAMA,TE，AECOMMON/X2/JM(100,3)，NZC(50），CJZ(100,2)，PJ（100，2),B(3,6），D(3，3）,S（3，6),TKZ(200，20),EKE(6,6),P(200)OPEN(5，FILE=’DATAIN’)！OPEN（6,FILE=’DATAOUT’，STATUS=’NEW'）CALL DATAIF（IND.EQ.0)GOTO 10EO=EO/（1.0—UN＊UN)UN=UN/(1。
0—UN）10 CALL TOTSTICALL LOADCALL SUPPORCALL SOLVEQCALL STRESSPAUSE!STOPENDSUBROUTINE DATACOMMON/X1/NJ,NE，NZ,NDD,NPJ，IND，NJ2，EO,UN，GAMA,TE,AECOMMON/X2/JM(100，3)，NZC(50），CJZ(100，2）,PJ（100，2),B(3，6)，D(3,3)，S（3，6)，TKZ（200,20），EKE（6,6），P(200)READ（5,*）NJ,NE，NZ,NDD,NPJ，INDNJ2=NJ*2NPJ1=NPJ+1READ(5，*)EO,UN，GAMA,TEREAD（5，*）((JM(I，J），J=1，3），I=1,NE)READ（5,＊）（(CJZ(I,J）,J = 1,2)，I=1，NJ)!Page150READ（5，*）（NZC（I),I=1，NZ）READ(5,＊)（(PJ(I，J），J=1,2),I=1，NPJ1)WRITE(6，10）（I，(CJZ(I,J）,J=1，2），I=1，NJ)10 FORMA T(4X,2HNO，6X，1HX,6X,1HY/（I6，2X，F7。
fortran程序设计第4章xhb
END IF ELSE
PRINT *, ‘D’ END IF
[例4.4] 三个数A、B、C，按升序排序。
READ (*, *) A, B, C IF (A .LE. B) THEN ELSE
T=A A=B B=T END IF IF (B .LE. C) THEN ELSE T=B B=C C=T IF (A .LE. B) THEN ELSE
用块IF结构实现选择 结构，其形式为：
IF (条件) THEN then块
ELSE else块
END IF
不成立
成立
条件
else块
then块
[例4.1]计算职工工资。工人每小时计时工资为 RATE，如果一周工作时间超过40小时，加班部分 的工资按正常时间工资的1.5倍计算。
读入RATE, HOURS
Less Than Less than or Equal to
EQual to Not Equal to
数学符号 > ≥ < ≤ = ≠
关系表达式示例：
关系表达式 A .GT. 3.5 A+B .LE. 0.0 SIN(X) .GE. 0.5 A-B .NE. C+D
I .LT. J/2
数学式子 A>3.5
[例4.3]如果在上例的基础上将80分以上定为A等，70~79 分定为B等，60~69分定为C等，小于60分的为D等。
READ (*, *) GRADE IF (GRADE .GE. 60.0) THEN
IF (GRADE .GE. 70) THEN IF (GRADE .GE. 80.0) THEN PRINT *, ‘A’ ELSE PRINT *, ‘B’ END IF
fortran语法手册范本
1 FORTRAN77四如此运算符+ - * / ** (其中**表示乘方)在表达式中按优先级次序由低到高为： +或-→*或/→**→函数→()2 FORTRAN77变量类型2.1 隐含约定：I-N规如此但凡以字母I，J，K，L，M，N六个字母开头的，即认为是整型变量，其它为实型变量。
如 IMPLICIT REAL (I,J)三种定义的优先级别由低到高顺序为：I-N规如此→IMPLICIT语句→类型说明语句，因此，在程序中IMPLICIT语句应放在类型说明语句之前。
2.4 数组的说明与使用使用I-N规如此时用DIMENSION说明数组，也可在定义变量类型同时说明数组，说明格式为：数组名(下标下界,下标上界〕，也可省略下标下界，此时默认为1，例：DIMENSION IA(0:9),ND(80:99),W(3,2),NUM(-1:0),A(0:2,0:1,0:3)REAL IA(10),ND(80:99)使用隐含DO循环进展数组输入输出操作：例如WRITE(*,10) ('I=',I,'A=',A(I),I=1,10,2)10FORMAT(1X,5(A2,I2,1X,A2,I4))2.5 使用DATA语句给数组赋初值变量表中可出现变量名,数组名,数组元素名,隐含DO循环，但不许出现任何形式的表达式：例如DATA A,B,C/3*-1.0/CHARACTER*6 CHN(10)DATA CHN/10*' '/INTEGER NUM(1000)DATA (NUM(I),I=1,500)/500*0/,(NUM(I),I=501,1000)/500*1/3 FORTRAN77程序书写规如此程序中的变量名，不分大小写；变量名称是以字母开头再加上1到5位字母或数字构成，即变更名字串中只有前6位有效；一行只能写一个语句；程序的第一个语句固定为PROGRAM 程序名称字符串某行的第１个字符至第５个字符位为标号区，只能书写语句标号或空着或注释内容；某行的第１个字符为Ｃ或＊号时，如此表示该行为注释行，其后面的内容为注释内容；某行的第６个字符位为非空格和非０字符时，如此该行为上一行的续行，一个语句最多可有19个续行；某行的第７至７２字符位为语句区，语句区内可以任加空格以求美观；某行的第７３至８０字符位为注释区，８０字符位以后不能有内容。
Fortran95程序设计课后习题答案(word版方便).docx
第四章1.program main implicit none write(*,*)"Have a good time."write(*,*)"That's not bad."write(*,*) '"Mary" isn''t my name.' end program2.program main real, parameter :: PI=3implicit none.14159real radius write(*,*) "请输入半径长 "read(*,*)radius write(*,"('面积 ='f8.3)")radius*radius*PI end program3.program main implicit none real grades write(*,*)"请输入成绩 "read(*,*)grades write(*,"('调整后成绩为 'f8.3)") SQRT(grades)*10.0 end program4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a! 输出 1,因为使用整数计算,小数部分会无条件舍去write(*,*) rb/ra! 输出 1.55.program main implicit none type distance real meter,inch,cm end type type(distance) ::d write(*,*)" 请输入长度 :"read(*,*)d%meter d%cm = d%meter*100 d%inch=d%cm/2.54write(*,"(f8.3'米 ='f8.3' 厘米 ='f8.3' 英寸 ')") d%meter,d%cm, d%inch end program第五章1.program main implicit none integer money real tax write(*,*) "请输入月收入"read(*,*) money if ( money<1000 ) then tax = 0.03else if ( money<5000) then tax=0.1else tax=0.15end if write(*,"('税金为 'I8)")nint(money*tax)end program2.program main implicit none integer day character(len=20) :: tv write(*,*) "请输入星期几 "read(*,*) day select case(day)case(1,4)tv = " 新闻 "case(2,5)tv = " 电视剧"case(3,6)tv=" 卡通 "case(7)tv = " 电影 "case default write(*,*) "错误的输入 "stop end select write(*,*) tv end program3.program main implicit none integer age, money real tax write(*,*)" 请输入年龄 " read(*,*)age write(*,*)"请输入月收入 "read(*,*)money if (age<50 )then if ( money<1000 ) then tax = 0.03else if ( money<5000 )then tax = 0.10else tax = 0.15end if else if(money<1000) then tax= 0.5else if( money<5000 )then tax = 0.7else tax = 0.10end if end if write(*,"('税金为 'I8)") nint(money*tax) end program4.program main implicit none integer year, days logical mod_4,mod_100, mod_400 write(*,*)" 请输入年份 "read(*,*) year mod_4= ( MOD(year,4)== 0 )mod_100 = ( MOD(year,100) == 0 )mod_400 = (MOD(year,400) ==0)if ((mod_4.NEQV. mod_100) .or. mod_400 ) then days = 366else days = 365end if write(*,"('这一年有 'I3' 天 ')") days stop end program第六章1.program main implicit none integer i do i=1,5write(*,*)"Fortran"end do stop end program2.program main implicit none integer i,sum sum = 0do i=1,99,2sum = sum+i end do write(*,*) sum stop end program3.program main implicit none integer,parameter:: answer= 45integer,parameter :: max = 5integer weight, i do i=1,max write(*,*) "请输入体重 "read(*,*) weight if (weight==answer) exit end do if(i<=max ) then write(*,*)" 猜对了 "else write(*,*) "猜错了 "end if stop end program4.program main implicit none integer, parameter :: max=10integer i real item real ans ans = 1.0item = 1.0do i=2,max item = item/real(i)ans = ans+itemend do write(*,*) ans stop end program5.program main implicit none integer, parameter :: length = 79character(len=length) :: input,output integer i,j write(*,*)"请输入一个字串 "read(*,"(A79)")input j=1 do i=1, len_trim(input)if ( input(i:i) /= ' ' ) then output(j:j)=input(i:i)j=j+1end if end do write(*,"(A79)") output stop end program第七章1.program main implicit none integer,parameter:: max= 10integer i integer:: a(max) =(/ (2*i,i=1,10) /) integer :: t!sum() 是 fortran库函数write(*,*) real(sum(a))/real(max)stop end program2.integer a(5,5)!5*5=25integer b(2,3,4)!2*3*4=24integer c(3,4,5,6) !3*4*5*6=360 integer d( -5:5)! 11 integer e( -3:3, -3:3)! 7*7=493.program main implicit none integer,parameter:: max=10integer f(max)integer i f(1)=0f(2)=1do i=3,max f(i)=f(i -1)+f(i-2)end do write(*,"(10I4)")f stop end program4.program main implicit none integer,parameter::size=10integer:: a(size)=(/ 5,3,6,4,8,7,1,9,2,10/)integer::i,j integer::t do i=1, size-1do j=i+1,size if ( a(i) < a(j) ) then ! a(i)跟 a(j)交换t=a(i)a(i)=a(j)a(j)=t end if end do end do write(*,"(10I4)")a stop end5.a(2,2)!1+(2 -1)+(2-1)*(5)=7a(3,3)! 1+(3-1)+(3-1)*(5) = 13第八章1.program main implicit none real radius,area write(*,*)" 请输入半径长 " read(*,*) radius call CircleArea(radius, area)write(*,"('面积 = 'F8.3)") area stop end program subroutine CircleArea(radius, area)implicit none real, parameter:: PI=3.14159 real radius, area area = radius*radius*PI return end subroutine2.program main implicit none real radius real,external:: CircleArea write(*,*)" 请输入半径长 "read(*,*)radius write(*,"('面积 ='F8.3)")CircleArea(radius)stop end program real function CircleArea(radius)implicit none real,parameter:: PI=3.14159 real radius CircleArea = radius*radius*PI return end function3.program main implicit none call bar(3)call bar(10)stop end program subroutine bar(length)implicit none integer,intent(in)::length integer i character(len=79)::string string=" "do i=1,length string(i:i)='*'end do write(*,"(A79)") string return end subroutine4.program main implicit none integer, external :: add write(*,*) add(100) end program recursive integer function add(n)result(sum)implicit none integer, intent(in):: n if ( n<0 ) then sum=0return else if ( n<=1 ) then sum=n return end if sum = n + add(n-1) return end function5.program main implicit none integer, external :: gcd write(*,*) gcd(18,12) end program integer function gcd(A,B)implicit none integer A,B,BIG,SMALL,TEMP BIG=max(A,B) SMALL=min(A,B)do while(SMALL /= 1 )TEMP=mod(BIG,SMALL)if ( TEMP==0 ) exit BIG=SMALL SMALL=TEMP end do gcd=SMALL return end function6.program main use TextGraphLib implicit none integer,parameter::maxx=60, maxy=20real,parameter:: StartX=0.0,EndX=3.14159*2.0real,parameter::xinc= (EndX-StartX)/(maxx -1)real x integer i,px,py call SetScreen(60,20)call SetCurrentChar('*')x=StartX do px=1,maxx py= (maxy/2)*sin(x)+maxy/2+1callPutChar(px,py)x=x+xinc end docall UpdateScreen()stop end program第九章1.program main implicit none character(len=79)::character(len=79)::buffer integer,parameter:: fileid = 10integer count integer::status=0logical alive write(*,*)":"read(*,"(A79)")inquire(,exist=alive)if(alive)then open(unit=fileid, , &access="sequential", status="old")count = 0do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit!没有资料就跳出循环write(*,"(A79)")buffer count=count+1if( count==24)then pause count=0end if end do else write(*,*)TRIM(),"doesn't exist." end if stop end2.program main implicit none character(len=79)::character(len=79)::buffer integer, parameter :: fileid = 10integer i integer :: status = 0logical alive write(*,*) ":" read(*,"(A79)")inquire(, exist=alive)if (alive )then open(unit=fileid,,& access="sequential",status="old")do while(.true.)read(unit=fileid,fmt="(A79)", iostat=status)buffer if(status/=0)exit!没有资料就跳出循环do i=1, len_trim(buffer)buffer(i:i) = char( ichar(buffer(i:i))-3 )end do write(*,"(A70)") buffer end do else write(*,*) TRIM()," doesn't exist."end if stop end3.program main implicit none type student integer chinese, english,math, science, social,total end type type(student)::s,total integer,parameter:: students=20, subjects=5integer i open(10,file="grades.bin",access="direct",recl=1)write(*,"(7A10)") " 座号 "," 中文 "," 英文 "," 数学 "," 自然 "," 社会 "," 总分 "total=student(0,0,0,0,0,0)do i=1, students read(10,rec=(i -1)*subjects+1)s%chinese read(10,rec=(i -1)*subjects+2) s%english read(10,rec=(i -1)*subjects+3)s%math read(10,rec=(i -1)*subjects+4) s%science read(10,rec=(i -1)*subjects+5)s%social s%total= s%chinese+s%english+s%math+s%science+s%social total%chinese= total%chinese+s%chinese total%english= total%english+s%english total%math= total%math+s%math total%science = total%science+s%science total%social=total%social+s%social total%total= total%total+s%total write(*,"(7I10)") i, s end do write(*,"(A10,6F10.3)") " 平均 ", & real(total%chinese)/real(students),&real(total%english)/real(students),& real(total%math)/real(students),&real(total%science)/real(students),& real(total%social)/real(students),&real(total%total)/real(students)stop end4.program main implicit none character(len=79)::character(len=79)::buffer integer, parameter :: fileid = 10integer i integer :: status = 0logical alive write(*,*) ":"read (*,"(A79)")inquire( , exist=alive)if ( alive ) then open(unit=fileid, , & access="sequential",status="old")do while(.true.)read(unit=fileid,fmt="(A79)", iostat=status)buffer if(status/=0)exit!没有数据就跳出循环do i=1, len_trim(buffer)buffer(i:i)=char(ichar(buffer(i:i)) -(mod(i -1,3)+1))end do write(*,"(A70)")buffer end do else write(*,*)TRIM()," doesn't exist."end if stop end5.module typedef type student integer::num integer::Chinese,English, Math, Natural, Social integer :: total integer :: rank end type end module program main use typedef implicit none integer,parameter::integer,parameter::students=20 character(len=80):: tempstr type(student) :: s(students) !储存学生成绩type(student) :: total!计算平均分数用integer i,num,error open(fileid,file="grades.txt",status="old",iostat=error)if( error/=0)then write(*,*)"Open grades.txt fail."stop end if read(fileid,"(A80)")tempstr! 读入第一行文字total=student(0,0,0,0,0,0,0,0)! 用循环读入每位学生的成绩do i=1,students read(fileid,*) s(i)%num, s(i)%Chinese, s(i)%English, &s(i)%Math, s(i)%Natural, s(i)%Social!计算总分s(i)%Total=s(i)%Chinese +s(i)%English+& s(i)%Math + s(i)%Natural + s(i)%Social!累加上各科的分数,计算各科平均时使用total%Chinese =total%Chinese+s(i)%Chinese total%English=total%English+ s(i)%English total%Math=total%Math+ s(i)%Math total%Natural=total%Natural+ s(i)%Natural total%Social= total%Social + s(i)%Social total%Total= total%Total + s(i)%Total end do call sort(s,students)!重新输出每位学生成绩write(*,"(8A7)") "座号 "," 中文 ","英文 "," 数学 "," 自然 "," 社会 "," 总分 "," 名次 "do i=1,students write(*,"(8I7)")s(i)end do!计算并输出平圴分数write(*,"(A7,6F7.1)")"平均 ",& real(total%Chinese)/real(students),&real(total%English)/real(students),&real(total%Math) /real(students),&real(total%Natural)/real(students),&real(total%Social)/real(students),& real(total%Total)/real(students)stop end program subroutine sort(s,n)use typedef implicit none integer n type(student) :: s(n), t integer i,j do i=1,n -1do j=i+1,n if ( s(i)%total < s(j)%total ) then t = s(i)s(i)=s(j)s(j) = t end if end do end do forall(i=1:n)s(i)%rank = i end forall end subroutine第十章1.integer(kind=4):: a! 4bytes real(kind=4):: b! 4 bytes real(kind=8):: c!8bytes character(len=10):: str!10bytes integer(kind=4),pointer:: pa ! 4 bytes real(kind=4), pointer :: pb! 4 bytes real(kind=8), pointer :: pc! 4 bytes character(len=10), pointer :: pstr ! 4 bytes type student integer Chinese, English, Math end type type(student) :: s! 12 bytes type(student), pointer :: ps ! 4 bytes2.integer, target :: a = 1 integer, target :: b = 2 integer, target :: c = 3 integer, pointer :: p p=>awrite(*,*) p! 1 p=>b write(*,*) p! 2 p=>c p=5 write(*,*) c! 53.module linklist type student integer :: num integer :: Chinese, English, Math, Science, Social end type type datalink type(student) :: item type(datalink), pointer :: next end type contains function SearchList(num, head)implicit none integer:: num type(datalink),pointer::head,p type(datalink),pointer::SearchList p=>head nullify(SearchList) do while( associated(p) )if ( p%item%num==num ) then SearchList => p return end if p=>p%next end do return end function end module linklist program ex1016use linklist implicit none character(len=20)::character(len=80):: tempstr type(datalink),pointer::head type(datalink),pointer:: p type(student), allocatable :: s(:)integer i,error,size write(*,*) ":"read(*,*)open(10, , status="old", iostat=error)if ( error/=0 ) then write(*,*) "Open !"stop end if allocate(head) nullify(head%next)p=>head size=0read(10, "(A80)") tempstr !读入第一行字符串 ,不需要处理它!读入每一位学生的成绩do while(.true.)read(10,fmt=*,iostat=error) p%item if( error/=0) exit size=size+1allocate(p%next,stat=error)! 新增下一个数据if ( error/=0 ) then write(*,*) "Out of memory!"stop end if p=>p%next !移动到链表的下一个数据nullify(p%next)end do write(*,"('总共有 ',I3,'位学生 ')")size allocate(s(size))p=>head do i=1,size s(i)=p%item p=>p%next end do do while(.true.)write(*,*) "要查询几号同学的成绩?"read (*,*) i if ( i<1 .or. i>size ) exit !输入不合理的座号write(*,"(5(A6,I3))")"中文 ",s(i)%Chinese,&" 英文 ",s(i)%English,&" 数学 ",s(i)%Math,&" 自然",s(i)%Science,&" 社会 ",s(i)%Social end do write(*,"(' 座号 ',I3,' 不存在 ,程序结束 .')") i stop end program4.module typedef implicit none type:: datalink integer:: i type(datalink), pointer:: next end type datalink end module typedef program ex1012use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:'read(*,*) n allocate( head )head%i=1nullify(head%next)p=>head do i=2,n allocate(p%next,stat=err )if (err/= 0)then write(*,*)'Out of memory!' stop end if p=>p%next p%i=i end do nullify(p%next)p=>head do while(associated(p))write(*,"(i5)") p%i p=>p%next end do!释放链表的存储空间p=>head do while(associated(p))next => p%next deallocate(p)p=>next end do stop end program第十一章1.module utility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r)real, parameter:: PI=3.14159real r CircleArea=r*r*PI return end function real function RectArea(a,b)real a,b RectArea=a*b return end function end module program main use UTILITY implicit none write(*,*) area(1.0)write(*,*) area(2.0,3.0) stop end program2.module time_utility implicit none type :: time integer::hour,minute,second end type time interface operator(+)module procedure add_time_time end interface contains function add_time_time( a, b )implicit none type(time) :: add_time_time type(time),intent(in)::a,b integer::seconds,minutes,carry seconds=a%second+b%second carry=seconds/60 minutes=a%minute+b%minute+carry carry=minutes/60 add_time_time%second=mod(seconds,60)add_time_time%minute=mod(minutes,60) add_time_time%hour=a%hour+b%hour+carry return end function add_time_time subroutine input( a )implicit none type(time), intent(out) :: a write(*,*) " Input hours:"read(*,*)a%hour write(*,*)"Input minutes:"read(*,*)a%minute write(*,*)"Input seconds:"read (*,*)a%second return end subroutine input subroutine output( a )implicit none type(time), intent(in)::a write(*,"(I3,' hours',I3,' minutes',I3,' seconds')" ) a%hour,a%minute,a%second return end subroutine output end module time_utility program main use time_utility implicit none type(time):: a,b,c call input(a)call input(b)c=a+b call output(c)stop end program main3.module rational_utility implicit none private public:: rational, & operator(+),operator( -),operator(*),&operator(/),assignment(=),operator(>),& operator(<),operator(==), operator(/=),&output,input type:: rational integer :: num,denom end type rational interface operator(+)module procedure rat__rat_plus_rat end interface interface operator( -)module procedure rat__rat_minus_rat end interface interface operator(*)module procedure rat__rat_times_rat end interface interface operator(/)module procedure rat__rat_div_rat end interface interface assignment(=)module procedure rat_eq_rat module procedure int_eq_rat module procedure real_eq_rat endinterface interface operator(>)module procedure rat_gt_rat end interface interface operator(<)module procedure rat_lt_rat end interface interface operator(==) module procedure rat_compare_rat end interface interface operator(/=)module procedure rat_ne_rat end interface contains function rat_gt_rat(a,b)implicit none logical :: rat_gt_rat type(rational),intent(in)::a,b real::fa,fb fa=real(a%num)/real(a%denom)fb=real(b%num)/real(b%denom)if(fa>fb ) then rat_gt_rat=.true.else rat_gt_rat=.false.end if return end function rat_gt_rat function rat_lt_rat(a,b)implicit none logical:: rat_lt_rat type(rational),intent(in)::a,b real::fa,fb fa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom)if( fb>fa) then rat_lt_rat=.true.else rat_lt_rat=.false.end if return end function rat_lt_rat function rat_compare_rat(a,b)implicit none logical:: rat_compare_rat type(rational), intent(in)::a,b type(rational)::c c=a-b if ( c%num==0)then rat_compare_rat=.true.else rat_compare_rat=.false.end if return end function rat_compare_rat function rat_ne_rat(a,b)implicit none logical:: rat_ne_rat type(rational),intent(in)::a,b type(rational):: c c=a-b if ( c%num==0)then rat_ne_rat=.false.else rat_ne_rat=.true.end if return end function rat_ne_rat subroutine rat_eq_rat(rat1, rat2)implicit none type(rational),intent(out)::rat1type(rational),intent(in)::rat2rat1%num= rat2%num rat1%denom=rat2%denom return end subroutine rat_eq_rat subroutine int_eq_rat( int, rat )implicit none integer, intent(out):: int type(rational), intent(in):: rat int= rat%num/rat%denom return end subroutine int_eq_rat subroutine real_eq_rat( float,rat)implicit none real,intent(out)::float type(rational),intent(in):: rat float = real(rat%num) / real(rat%denom)return end subroutine real_eq_rat function reduse( a )implicit none type(rational), intent(in)::a integer::b type(rational)::reduse b=gcv_interface(a%num,a%denom)reduse%num=a%num/b reduse%denom= a%denom/b return end function reduse function gcv_interface(a,b)implicit none integer, intent(in) :: a,b integer :: gcv_interface if ( min(a,b) .eq. 0 ) then gcv_interface=1return end if if(a==b)then gcv_interface=a return else if(a>b)then gcv_interface=gcv(a,b)else if(a<b)then gcv_interface=gcv(b,a)end if return end function gcv_interface recursive function gcv(a,b) result(ans)implicit none integer, intent(in) :: a,b integer:: m integer :: ans m=mod(a,b)select case(m)case(0)ans=b return case(1)ans=1return case default ans=gcv(b,m)end select return end function gcv function rat__rat_plus_rat( rat1,rat2)implicit none type(rational) :: rat__rat_plus_rat type(rational), intent(in) :: rat1,rat2type(rational) :: act act%denom= rat1%denom * rat2%denom act%num= rat1%num*rat2%denom + rat2%num*rat1%denom rat__rat_plus_rat =reduse(act)return end function rat__rat_plus_rat function rat__rat_minus_rat(rat1,rat2)implicit none type(rational):: rat__rat_minus_rat type(rational),intent(in)::rat1,rat2 type(rational):: temp temp%denom= rat1%denom*rat2%denom temp%num= rat1%num*rat2%denom- rat2%num*rat1%denom rat__rat_minus_rat= reduse(temp) return end function rat__rat_minus_rat function rat__rat_times_rat(rat1,rat2)implicit none type(rational) :: rat__rat_times_rat type(rational), intent(in) :: rat1, rat2 type(rational):: temp temp%denom= rat1%denom*rat2%denom temp%num= rat1%num *rat2%num rat__rat_times_rat= reduse(temp)return end function rat__rat_times_rat function rat__rat_div_rat( rat1,rat2)implicit none type(rational) :: rat__rat_div_rat type(rational), intent(in) :: rat1, rat2type(rational) :: temp temp%denom= rat1%denom*rat2%num temp%num= rat1%num* rat2%denom rat__rat_div_rat =reduse(temp)return end function rat__rat_div_rat subroutine input(a)implicit none type(rational),intent(out):: a write(*,*)" 分子 :"read(*,*)a%num write(*,*)" 分母 :"read(*,*)a%denom return end subroutine input subroutine output(a)implicit none type(rational), intent(in) :: a if ( a%denom/=1 ) then write(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom else write(*,"(I3)" )a%num end if return end subroutine output end module rational_utility program main use rational_utility implicit none type(rational) :: a,b,c call input(a)call input(b)c=a+b write(*,*)"a+b="call output(c)c=a-b write(*,*)"a -b="call output(c)c=a*b write(*,*)"a*b="call output(c)c=a/b write(*,*)"a/b="call output(c)if (a>b) write(*,*) "a>b"if (a<b) write(*,*) "a<b"if (a==b) write(*,*) "a==b"if (a/=b) write(*,*) "a/=b" stop end program main4.module vector_utility implicit none type vector real x,y end type interface operator(+)module procedure vector_add_vector end interface interface operator( -) module procedure vector_sub_vector end interface interface operator(*)module procedure real_mul_vector module procedure vector_mul_real module procedure vector_dot_vector end interface interface operator(.dot.)module procedure vector_dot_vector end interface contains type(vector) function vector_add_vector(a,b) type(vector), intent(in) :: a,b vector_add_vector = vector(a%x+b%x, a%y+b%y)end function type(vector) function vector_sub_vector(a,b)type(vector),intent(in)::a,b vector_sub_vector= vector(a%x-b%x, a%y-b%y)end function type(vector)function real_mul_vector(a,b)real, intent(in):: a type(vector),intent(in)::b real_mul_vector = vector(a*b%x, a*b%y)end functiontype(vector)function vector_mul_real(a,b) type(vector), intent(in) :: a real, intent(in) :: b vector_mul_real = real_mul_vector(b,a) end function real function vector_dot_vector(a,b)type(vector), intent(in) ::a,b vector_dot_vector= a%x*b%x+a%y*b%y end function subroutine output(vec) type(vector) :: vec write(*,"('('F6.2','F6.2')')")vec end subroutine end module program main use vector_utility implicit none type(vector)a,b,c a=vector(1.0, 2.0) b=vector(2.0, 1.0)c=a+b call output(c)c=a-b call output(c)write(*,*)a*b end program main。
(完整版)fortran文件操作
fortran文件操作From: 《Fortran 95 程序设计》彭国伦1.文件读取的概念：读取：“顺序读取”和“直接读取”。
保存：“文本文件”和“二进制文件”。
二进制文件：读取快，因为保存格式和数据在内存中的保存方法一样，同时也节省空间。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－2. 文件的操作：－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－open的使用：使用open命令打开文件之后，就可以对文件来做输入输出。
example:program ex0901impicit noneopen(unit=10, file='hello.txt') ! 打开hello.txt文件, unit指定文件代码，file 指定文件名称。
write(10, *) "hello" !在代码为10的文件中写入hellostopend program ex0901open中有很多参数可以使用，详细如下：OPEN(UNIT=number, FILE='filename', FORM='...', STATUS='...', ACCESS='...', RECL=length, ERR=label, IOSTAT=iostat, BLANK='...', POSITION='...', ACTION=action, PAD='...', DELIM='...')UNIT='number'： number必须是一个正整数，它可以使用变量或是常量来赋值。
number最好避开1,2,5,6。
因为2,6是默认的输出位置，也就是屏幕。
1，5则是默认的输入位置，键盘。
FILE='filename'：指定要打开的文件名称，文件名要符合系统规定。
计算材料学Fortran程序汇总
INTEGER M(1:10000), NUMBER1(0:364), NUMBER2REAL X,YISEED=RTC()DO J=1, 10000NUMBER1=0X=RAN(ISEED)NUMBER1(0)=INT(365*X+1)JJJ=1DO I=1,364Y=RAN(ISEED)NUMBER2=INT(365*Y+1)ETR=COUNT(NUMBER1.EQ.NUMBER2)IF (ETR= =1) THENEXITELSEJJJ=JJJ+1M(J)=JJJNUMBER1(I)=NUMBER2END IFEND DOEND DODO I=1,10000IF(M(I).LE.23) SUM=SUM+1END DOPRINT *,SUM/10000END=================================================Monte Carlo Simulation of One Dimensional DiffusionINTEGER X,XX(1:1000,1:1000)REAL XXM(1:1000)! X:INSTANTANEOUS POSITION OF ATOM! XX(J,I)：X*X ,J:第几天实验,I:第几步跳跃! XXM(I): THE MEAN OF XXWRITE(*,*) "实验天数JMAX，实验次数IMAX"READ(*,*) JMAX,IMAXISEED=RTC()DO J=1,JMAX !第几天实验X=0 !!!DO I=1,IMAX !第几步跳跃RN=RAN(ISEED)IF(RN<0.5)THENX=X+1ELSEX=X-1END IFXX(J,I)=X*XEND DOEND DOOPEN(1,FILE="C:\DIF1.DAT")DO I=1,IMAXXXM=0.0XXM(I)=1.0*SUM(XX(1:JMAX,I))/JMAX !!WRITE(1,*) I, XXM(I)END DOCLOSE(1)END============================================================ ! Monte Carlo Simulation of Two Dimensional DiffusionINTEGER X,Y,XY(1:1000,1:1000)REAL XYM(1:1000)! X:INSTANTANEOUS POSITION OF ATOM! XY(J,I)：X*Y ,J:第几天实验,I:第几步跳跃! XYM(I): THE MEAN OF XYWRITE(*,*) "实验天数JMAX，实验次数IMAX"READ(*,*) JMAX,IMAXISEED=RTC()DO J=1,JMAX !第几天实验X=0 !!!Y=0 !!!DO I=1,IMAX !第几步跳跃RN=RAN(ISEED)IF(RN.LT.0.25)THENx=xy=y-1END IFIF(RN.LT.0.5.AND.RN.GE.0.25)THENx=xy=y+1END IFIF(RN.LT.0.75.AND.RN.GE.0.5)THENx=x-1y=yEND IFIF(RN.GE.0.75)THENx=x+1y=yEND IFXY(J,I)=X*X+Y*YEND DOEND DOOPEN(1,FILE="C:\DIF2.DAT")DO I=1,IMAXXYM=0.0XYM(I)=1.0*SUM(XY(1:JMAX,I))/JMAX !!WRITE(1,*) I, XYM(I)END DOCLOSE(1)END===============================================! Monte Carlo Simulation of One Dimensional Diffusion INTEGER X,XY(1:1000,1:1000),y,XN(1:4),YN(1:4),RNREAL XYM(1:1000)! X:INSTANTANEOUS POSITION OF ATOM! XY(J,I)：X*Y ,J:第几天实验,I:第几步跳跃! XYM(I): THE MEAN OF XYWRITE(*,*) "实验天数JMAX，实验次数IMAX"READ(*,*) JMAX,IMAXXN=(/0,0,-1,1/)YN=(/-1,1,0,0/)ISEED=RTC()DO J=1,JMAX !第几天实验X=0 !!!Y=0 !!!DO I=1,IMAX !第几步跳跃RN=4*RAN(ISEED)+1X=X+YN(RN)Y=Y+YN(RN)XY(J,I)=X*X+Y*YEND DOEND DOOPEN(1,FILE="C:\DIF2.DAT")DO I=1,IMAXXYM=0.0XYM(I)=1.0*SUM(XY(1:JMAX,I))/JMAX !!WRITE(1,*) I, XYM(I)END DOCLOSE(1)END做三维空间随机行走？？留作业! Monte Carlo Simulation of One Dimensional Diffusion INTEGER X,XY(1:1000,1:1000),y,XN(1:6),YN(1:6),ZN(1:6),RN REAL XYM(1:1000)! X:INSTANTANEOUS POSITION OF ATOM! XY(J,I)：X*Y ,J:第几天实验,I:第几步跳跃! XYM(I): THE MEAN OF XYWRITE(*,*) "实验天数JMAX，实验次数IMAX"READ(*,*) JMAX,IMAXXN=(/0,0,-1,1,0,0/)YN=(/-1,1,0,0,0,0/)ZN=(/0,0,0,0,1,-1/)ISEED=RTC()DO J=1,JMAX !第几天实验X=0 !!!Y=0 !!!Z=0DO I=1,IMAX !第几步跳跃RN=6*RAN(ISEED)+1X=X+XN(RN)Y=Y+YN(RN)Z=Z+ZN(RN)XY(J,I)=X*X+Y*Y+Z*ZEND DOEND DOOPEN(1,FILE="C:\DIF2.DAT")DO I=1,IMAXXYM=0.0XYM(I)=1.0*SUM(XY(1:JMAX,I))/JMAX !!WRITE(1,*) I, XYM(I)END DOCLOSE(1)==============================================通过该程序了解fortran语言如何画图（通过像素画图）USE MSFLIBINTEGER XR，YR !在的区域中画一个圆PARAMETER XR=400,YR=400INTEGER R, S(1:XR,1:YR)X0=XR/2 ! 圆心位置X0，YOY0=YR/2R=MIN(X0-10,Y0-10) !圆半径S=0 !像素的初始状态（颜色）DO I=1,XRDO J=1,YRIF((I-X0)**2+(J-Y0)**2<=R**2)S(I,J)=10IER=SETCOLOR(S(I,J))IER=SETPIXEL(I,J)END DOEND DOEND=================================================! 画一个圆（1、如何选出晶界区域；2、进一步加深对画图的理解）USE MSFLIBINTEGER XR，YR !在的区域中画一个圆PARAMETER XR=400,YR=400INTEGER R, S(0:XR+1,0:YR+1), XN(1:4), YN(1:4), SNSXN=(/0,0,-1,1/)YN=(/-1,1,0,0/)X0=XR/2 ! 圆心位置X0，Y0Y0=YR/2R=MIN(X0-10,Y0-10) !圆半径S=0 !像素的初始状态（颜色）DO I=1,XRDO J=1,YRIF((I-X0)**2+(J-Y0)**2<=R**2)S(I,J)=10IER=SETCOLOR(S(I,J))IER=SETPIXEL(I,J)END DOEND DODO I=1,XR !画晶界DO J=1,YRNDS=0DO K=1,4IF(S(I,J).NE.S(I+XN(K),J+YN(K)))NDS=NDS+1END DOIF(NDS>0)THENIER=SETCOLOR(9)ELSEIER=SETCOLOR(8)END IFIER=SETPIXEL(I,J)END DOEND DOEND如何画有一定宽度的晶界？====================================================！MC模拟一个晶粒的缩小（1、如何定义基体和晶粒；（2、如何寻找边界；（3、如何计算能量（构造或描述问题的概率过程）步骤：1、在基体上画一个原始晶粒，并赋予基体和原始晶粒不同的状态（取向号或体积能）2、寻找晶界3、MC的一个时间步（晶粒长大过程中一种随机性）4、计算晶界上网格点的相互作用，每个格点的相互作用导致晶粒长大①随机选取一个初始格点；②若此点属于晶界，那么可以随机转变为它邻居的状态，若不是晶界，则跳出循环，不发生转变；③计算转变前后的能量变化，⊿E=⊿E v +⊿E s +⊿E q(自由能=体积能+表面能+能量起伏)④若⊿E小于0，则新晶相被接受，网格状态发生转变。
(完整word版)FORTRAN经典入门程序20例
对于FORTRA的初学者。
这些例子可作为小练习1.例题：计算工资问题。
每小时工资为RATE如果工作超过40小时，加班呢部分工资是正常时间工资的1.5倍。
C Payroll with overtimeprogram payrollreal rate, hours, payread (*,*) rate, hoursif (hours>40) thenpay=40*rate+(hours-40)*1.5*rateelsepay=hours*rateEND IFprint *, "rate=" , rateprint *, "hours=" , hoursprint *, "pay=" ,payend2•学生成绩问题。
大于80为A级。
大于60小于80为B级。
小于60为C级。
IF的嵌套。
注意空格可以看清楚else if ,e nd if,pri nt 的内容•PROGRAGRADESTUDENTREA0GRADEIF (GRADE .GE. 80) THENPRINT*,GRADE, "GRADE=>A"ELSEIF (GRADELT.60) THENPRINT*,GRADE"GRADE=>C"ELSEPRINT*,GRADE"GRADE=>B"END IFEND IFEND3. 三个数按从小到大排序。
PROGRA M AXMINREALA,B,C,TREA0A,B,CIF (A.GT.B) THENT=AA=BB=TELSEEND IFIF (B.GT.C) THENT=BB=CC=TELSEEND IFIF (A.GT.B) THENT=AA=BB=TEND IFPRINT*,A,B,CEND4. 运用EISE IF语句。
重做例子2PROGRAM2READ*,*) GRADEIF (GRADE .GE. 80.0) THENPRINT*, GRADE, "=>A"ELSE IF(GRADE .GE. 70.0) THENPRINT*, GRADE, "=>B"ELSE IF(GARDE .GE. 60.0) THENPRINT*, GRADE, "=>C"ELSEPRINT*, GARDE, "=>D"END IFEND3x 6,x 05. 计算y 2x 2x 8,x 0PROGRAEQUATIONREAD*,*) XIF (X .GE. 0.0) Y=3*X+6IF (X .LT. 0.0) Y=-X**2+2*X-8PRINT*, "X=" ,X, "Y=" ,YEND6. CONTINUED句。
Fortran语言编写的有限元结构程序
算例一计算简图及结果输出用平面刚架静力计算程序下图结构的内力。
各杆EA，EI相同。
已知：642EA=4.010KN,EI=1.610KN m⨯⨯∙计算简图如下：（1）输入原始数据控制参数3,5,8,7,1,2（NE,NJ,N,NW,NPJ,NPF）结点坐标集结点未知量编号0.0,0.0,0,0 0.0,4.0,1,2,3 0.0,4.0,1,2,4 4.0,4.0,5,6,7 4.0,0.0,0,0,8单元杆端结点编号及单元EA、EI 1,2,4.0E+06,1.6E+04 3,4,4.0E+06,1.6E+04 5,4,4.0E+06,1.6E+04结点荷载7.0,-15.非结点荷载1.0,2.0,2.0,-2.0,1.0,4.0,-25.0（2）输出结果NE= 3 NJ= 5 N= 8 NW= 7 NPJ= 1 NPF= 2 NODE X Y XX YY ZZ1 0.0000 0.0000 0 0 02 0.0000 4.0000 1 2 33 0.0000 4.0000 1 2 44 4.0000 4.000056 75 4.0000 0.0000 0 0 8ELEMENT NODE-I NODE-J EA EI1 12 0.400000E+07 0.160000E+052 3 4 0.400000E+07 0.160000E+053 54 0.400000E+07 0.160000E+05CODE PX-PY-PM7. -15.0000ELEMENT IND A Q1. 2. 2.0000 -18.00002. 1. 4.0000 -25.0000NODE U V CETA1 0.000000E+00 0.000000E+00 0.000000E+002 -0.221743E-02 -0.464619E-04 -0.139404E-023 -0.221743E-02 -0.464619E-04 0.357876E-024 -0.222472E-02 -0.535381E-04 -0.298554E-025 0.000000E+00 0.000000E+00 0.658499E-03ELEMENT N Q M1 N1= 46.4619 Q1= 10.7119 M1= -6.8477N2= -46.4619 Q2= 7.2881 M2= 0.00002 N1= 7.2881 Q1= 46.4619 M1= 0.0000N2= -7.2881 Q2= 53.5381 M2= 14.15233 N1= 53.5381 Q1= 7.2881 M1= 0.0000N2= -53.5381 Q2= -7.2881 M2= -29.1523算例二计算简图及结果输出用平面刚架静力计算程序下图结构的内力。
第二章写一个简单的FORTRAN程式
第二章寫一個簡單的FORTRAN程式2.1簡介下面是一個很簡單的程式，主要目的為讀入兩數，將其相加，再印出結果。
在FORTAN 90中允許下面兩種格式：(A) 固定格式(Fixed form)：用於FORTRAN77和更早期的FORTRAN(B) 自由格式(free form)：用於FORTRAN90和以後的版本(g77也可以使用)2.2 字元集(Character set)撰寫程式可以使用的基本符號稱為字元(characters)，在FORTRAN 77中可以使用的字元包括：(1)文字字元(alphabetic characters)：由A至Z共26個字元(2)數字字元(numerical characters)：由0至9共10個字元(3)特殊字元(special characters)：包括空白(blank)和12個特殊符號+-*/.,()=’$:在FORTRAN 90中可以使用的字元較多，包括：(1) 大寫英文字母，由A至Z共26個字元。
(2) 小寫英文字母，由a至z共26個字元。
(3) 數字字元，由0至9共10個字元。
(4) underscore (_)(5) 計算符號：+ - * / **(6) 特殊字元(special characters)：包括空白(blank)和17個特殊符號 ( ) . ,= ‘ $ : ! “ % & ; < > ?2.3 FORTRAN敘述的結構(A)固定格式(Fixed form)FORTRAN程式由一系列的敘述(statement)所組成，FORTRAN 77編譯程式翻譯每一敘述時，只取1至72行各位置之字元編譯程式，根本不理會73行以後各字元，因此在寫程式時絕對不能超過72行之位置。
為增加程式的可讀性，使程式設計師和使用者了解程式的步驟，便於程式的修改與維護，程式設計師可以使用註解(Comment)，對程式的內容加以適當說明。
註解列可置於程式任何地方，但必須在第一格寫一個C或*，表示該列是註解敘述，在2~80格可以用任何符號(包括中文)書寫說明。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
1)实例3—求多个半径下的圆周长
! z3.f90 --Fortran95
! FUNCTIONS:
! z3 - Entry point of console application.
!************************************************************************* ! PROGRAM: z3
! PURPOSE: Entry point for the console application.
!************************************************************************ program z3
! 求多个半径下的圆周长
! 主程序
! PROGRAM Z3
PRINT *, 'R=',1.2,'C=',C(1.2)
PRINT *, 'R=',3.4,'C=',C(3.4)
PRINT *, 'R=',15.6,'C=',C(15.6)
PRINT *, 'R=',567.3,'C=',C(567.3)
END program z3
!子程序
FUNCTION C(R)
PI=3.1415926
C=2*PI*R
RETURN
! Body of z3
end
2)实例4—键盘与显示器输入/输出
a)Fortran 基本操作
b)程序指令
! ZXZ_I_O.f90
! FUNCTIONS:
! ZXZ_I_O - Entry point of console application.
! PROGRAM: ZXZ_I_O
! PURPOSE: Entry point for the console application.
!***************输入、输出样式种种************************** program ZXZ_I_O
implicit none
!变量声明的位置
INTEGER(2) i; INTEGER(4) j; INTEGER(4) m; REAL n
INTEGER A,B
! Variables
PRINT*,'输入整数A'; READ*, A
PRINT*,'输入整数B'; READ*, B
B=A+B
PRINT*,'B=A+B=',B
WRITE(*,*) 'A*B=',A*B
PRINT* ,'以上为计算机的计算结果，注意B的值'
!系统默认的输出样式
PRINT* ,'系统默认的输出样式'
!人为控制的的输出样式--格式化输出
i=21; j=53; m=5
n=(i+j*m*i**m)
WRITE(*,*) 'i,j,m 是常量，程序赋初值' PRINT*, i,j,m
WRITE(*,*) 'i,j,m 的计算结果：' PRINT*,'i+j*m*i**m=',n
PRINT* ,' '
! Body of ZXZ_I_O
end program ZXZ_I_O
程序说明：
程序赋值—初始化
i=21; j=53; m=5
键盘无格式输入
READ*, A
键盘有格式输入
READ（*, 100）A,B,C
100 FORMA T( 2F5.2,F5.3)
显示器无格式输出
PRINT* ,'系统默认的输出样式' WRITE(*,*) 'A*B=',A*B
显示器有格式输出
PRINT 100 ,A+B
WRITE(*,100) 'A*B=',A*B
100 FORMA T( F5.2)
c)调试运行
d)程序指令
带格式的输入输出
! ZXZ_I_O.f90
! FUNCTIONS:
! ZXZ_I_O - Entry point of console application.
! PROGRAM: ZXZ_I_O
! PURPOSE: Entry point for the console application.
!***************输入、输出样式种种************************** program ZXZ_I_O
implicit none
!变量声明的位置
INTEGER(2) i; INTEGER(4) j; INTEGER(4) m; REAL n
INTEGER A,B
REAL X,Y,Z
! Variables
PRINT*,'输入整数A'; READ*, A
PRINT*,'输入整数B'; READ*, B
PRINT*, '计算结果为：'
B=A+B
PRINT*,'B=A+B=',B
WRITE(*,*) 'A*B=',A*B
PRINT* ,'以上为计算机的计算结果，注意B的值'
!系统默认的输出样式
PRINT* ,'系统默认的输出样式'
PRINT*,'输入实数X'; READ(*,100) X
PRINT*,'输入实数Y'; READ(*,100) Y
100 FORMA T(F5.2)
PRINT*, '计算结果为：'
Z=X+Y
PRINT 200,Z
200 FORMA T(4X,'Z=X+Y=',F8.3)
WRITE(*,*)
WRITE(*,300) X*Y
300 FORMA T(4X,'Z=X*Y=',F8.3)
!人为控制的的输出样式--格式化输出
PRINT* ,'程序为常量赋了初值'
i=21; j=53; m=5
n=(i+j*m*i**m)
WRITE(*,*) 'i,j,m 是常量，程序赋初值'
PRINT*, i,j,m
WRITE(*,*) 'i,j,m 的计算结果：'
PRINT*,'i+j*m*i**m=',n
PRINT* ,' '
! Body of ZXZ_I_O
end program ZXZ_I_O e)调试运行。