fortran程序30个
Fortran程序总结
1.行的书写(行的长度、分行、续行)一行可以是0~132个字符，空格有意义，语句最长不超过2640个字符一行可以有多个语句，用“;”分隔一个语句可分行写，读行标记为&（放在尾部），但如为关键字，首尾均加&。
最多可有511个续行。
2.说明语句必须出现在可执行语句之前，格式说明语句（FORMAT语句）除外。
3.注释标志符：自由格式：！固定格式：C *语句分隔符：分号；（仅自由格式可以使用）续行符：自由格式：&申明标号：1到5位无符号整数空格：关键字、变量、常量内部不能用空格，但相邻两者之间须用空格4.信息处理的分类：数值处理和信息处理现代计算机工作原理：程序存储和程序控制（冯·诺依曼）1、运算器——算术运算、逻辑运算2、控制器——根据指令控制计算机工作运算器、控制器和寄存器称为中央处理器CPU3、I/O设备——提供数据传输服务4、总线——数据传输的公共通道1.机器语言：二进制代码形式，可以被计算机直接执行，不可移植2.汇编语言：用助记符来代替机器指令，容易记忆，不可移植3.高级语言：接近自然语言（英语）的程序设计语言，又称算法语言，易学、易用、易维护，可移植性好例：FORTRAN、BASIC、PASCAL、C、LISP、PROLOG等5.FORTRAN90程序是一种分块结构，由若干个程序单元块组成：主程序、外部子程序、模块、块数据单元无论是主程序单元，还是子程序单元，都是独立的程序单位，应该独立编写，它们的形式相似。
非语句行：注释语句：！后的所有字符都被编译器忽略。
可独占一行，也可在其它语句之后，空行为注释行（固定格式用C和*）6.常量的定义：常量是程序执行过程中不能变化的量。
基本数据类型有五种：整型、实型、复型、字符型和逻辑型前三种属于数值类型，后两种为非数值类型，主要用于文字处理和控制。
FORTRAN 90通过KIND值确定整数的存储开销、最大位数和取值范围，如表所示。
fortran指令大全
附录C SCILAB 部分函数指令表(c)LIAMA. All rights reserved.(注解:本指令表只收集了部分常用指令, 有关全部指令请参照文档文件)+ 加- 减* 矩阵乘数组乘*.1. 通用指令^ 矩阵乘方数组乘方^.\ 反斜杠或左除help 在线帮助/ 斜杠或右除apropos 文档中关键词搜寻或.\ 数组除/.ans 缺省变量名以及最新表达式的运算结果== 等号~= 不等号clear 从内存中清除变量和函数< 小于exit 关闭SCILAB> 大于quit 退出SCILAB<= 小于或等于save 把内存变量存入磁盘>= 大于或等于exec 运行脚本文件&,and 逻辑与mode 文件运行中的显示格式|,or 逻辑或getversion 显示SCILAB 版本~,not 逻辑非ieee 浮点运算溢出显示模式选择: 冒号who 列出工作内存中的变量名( ) 园括号edit 文件编辑器[ ] 方括号type 变量类型{ } 花括号what 列出SCILAB 基本命令小数点.format 设置数据输出格式, 逗号chdir 改变当前工作目录; 分号getenv 给出环境值// 注释号mkdir 创建目录= 赋值符号pwd 显示当前工作目录' 引号evstr 执行表达式' 复数转置号转置号'.ans 最新表达式的运算结果2.运算符和特殊算符%eps 浮点误差容限, =2-52≈2.22×10-16%i 虚数单位= √(-1)%inf 正无穷大%pi 圆周率,π=3.1415926535897....3. 编程语言结构abort 中止计算或循环break 终止最内循环case 同select 一起使用continue 将控制转交给外层的for或while循环else 同if一起使用elseif 同if一起使用end 结束for，while，if 语句for 按规定次数重复执行语句if 条件执行语句otherwise 可同switch 一起使用pause 暂停模式return 返回select 多个条件分支then 同if一起使用while 不确定次数重复执行语句eval 特定值计算feval 函数特定值计算或多变量计算function 函数文件头global 定义全局变量isglobal 检测变量是否为全局变量error 显示错误信息lasterror 显示最近的错误信息sprintf 按格式把数字转换为串warning 显示警告信息4.基本数学函数acos 反余弦acosh 反双曲余弦acot 反余切acoth 反双曲余切acsc 反余割acsch 反双曲余割asin 反正弦asinh 反双曲正弦atan 反正切atanh 反双曲正切cos 余弦cosh 双曲余弦cotg 余切coth 双曲余切sin 正弦sinh 双曲正弦tan 正切tanh 双曲正切exp 指数log 自然对数log10 常用对数log2 以2为底的对数sqrt 平方根abs 绝对值conj 复数共轭imag 复数虚部real 复数实部ceil 向上(正无穷大方向)取整fix 向零方向取整floor 向下(负无穷大方向)取整round 四舍五入取整sign 符号函数gsort 降次排序erf 误差函数erfc 补误差函数gamma gamma 函数interp 插值函数interpln 线性插值函数intsplin 样条插值函数smooth 样条平滑函数spline 样条函数quarewave 方波函数sign 符号函数double 将整数转换为双精度浮点数5.基本矩阵函数和操作eye 单位阵zeros 全零矩阵ones 全1 矩阵rand 均匀分布随机阵genmarkov 生成随机Markov 矩阵linspace 线性等分向量logspace 对数等分向量logm 矩阵对数运算cumprod 矩阵元素累计乘cumsum 矩阵元素累计和toeplitz Toeplitz 矩阵disp 显示矩阵和文字内容length 确定向量的长度size 确定矩阵的维数diag 创建对角阵或抽取对角向量find 找出非零元素1的下标matrix 矩阵变维rot90 矩阵逆时针旋转90度sub2ind 据全下标换算出单下标tril 抽取下三角阵triu 抽取上三角阵conj 共轭矩阵companion 伴随矩阵det 行列式的值norm 矩阵或向量范数nnz 矩阵中非零元素个数null 清空向量或矩阵中的某个元素orth 正交基rank 矩阵秩trace 矩阵迹cond 矩阵条件数rcond 逆矩阵条件数inv 矩阵的逆lu LU分解或高斯消元法pinv 伪逆qr QR分解givens Givens 变换linsolve 求解线性方程lyap Lyapunov 方程hess Hessenberg 矩阵poly 特征多项式schur Schur 分解expm 矩阵指数expm1 矩阵指数的Pade逼近expm2 用泰勒级数求矩阵指数expm3 通过特征值和特征向量求矩阵指数funm 计算一般矩阵函数logm 矩阵对数sqrtm 矩阵平方根6. 特性值与奇异值spec 矩阵特征值gspec 矩阵束特征值bdiag 块矩阵, 广义特征向量eigenmarkov 正则化Markov 特征向量pbig 特征空间投影svd 奇异值分解sva 奇异值分解近似7. 矩阵元素运算cumprod 元素累计积cumsum 元素累计和hist 统计频数直方图max 最大值mean 平均值median 中值min 最小值prod 元素积sort 由大到小排序std 标准差sum 元素和trapz 梯形数值积分corr 求相关系数或方差8. 稀疏矩阵运算sparse 稀疏矩阵(只存储非零元素)adj2sp 邻接矩阵转换为稀疏矩阵full 稀疏矩阵转换为全矩阵mtlb_sparse 将SCILAB 稀疏矩阵转换为MA TLAB稀疏矩阵格式sp2adj 稀疏矩阵转换为邻接矩阵speye 稀疏矩阵方式单位阵sprand 稀疏矩阵方式随机矩阵spzeros 稀疏矩阵方式全零阵lufact 稀疏矩阵LU分解lusolve 稀疏矩阵方程求解spchol 稀疏矩阵Cholesky分解9. 输入输出函数diary 生成屏幕文本记录disp 变量显示file 文件管理input 用户键盘输入load 读已存的变量mclose 关闭文件mget 读二进制文件mgetl 按行读ASCII码文件mgetstr 读字符串中单个字mopen 打开文件mput 写二进制文件mfscanf 读ASCII 码文件print 将变量记录为文件read 读矩阵变量save 存变量为二进制文件strartup 启动文件write 按格式存文件xgetfile 对话方式获取文件路径x_dialog 建立Xwindow参数输入对话框Tk_Getvar 得到Tk文件变量Tk_EvalFile 执行Tk 文件10. 函数与函数库操作deff 在线定义函数edit 函数编辑器function 打开函数定义functions SCILAB 函数或对象genlib 在给定目录下建立所有文件的函数库get_function_path 读函数库的文件存储目录路径getd 读函数库中的全部文件getf 在文件中定义一个函数lib 函数库定义macro SCILAB函数或对象macrovar 输入变量个数newfun 输出变量个数11. 字符串操作code2str 将SCILAB数码转换为字符串convstr 字母大小转换emptystr 清空字符串grep 搜寻相同字符串part 字符提取str2code 将字符串转换为SCILAB数码string 字符串转换strings SCILAB 对象, 字符串strcat 连接字符strindex 字符串的字符位置搜寻strsubst 字符串中的字符替换12. 日期与时间date 日期getdate 读日期与时间timer CPU时间计时13. 二维图形函数plot2d 直角坐标下线性刻度曲线champ 2 维向量场champ1 由颜色箭头表示的2维向量场contour2d 等高线图errbar 曲线上增加误差范围框线条grayplot 应用颜色表示的表面xgrid 画坐标网格线histplot 统计频数直方图Matplot 散点图阵列14. 三维图形函数plot3d 三维表面plot3d1 用颜色或灰度表示的三维表面param3d 三维中单曲线param3d1 三维中多曲线contour 三维表面上的等高线图hist3d 三维表示的统计频数直方图geom3d 三维向二维上的投影15. 线条类图形xpoly 单线条或单多边形xpolys 多线条或多各多边形xrpoly 正多边形xsegs 非连接线段xfpoly 单个多边形内填充xfpolys 多个多边形内填充xrect 矩形xfrect 单个矩形内填充xrects 多个矩形内填充xarc 单个弧线段或弧园xarcs 多个弧线段或弧园xfarc 单个弧线段或弧园填充xfarcs 多个弧线段或弧园填充xarrows 多箭头16. 图形注释, 变换xstring 图形中字符xstringb 框内字符xtitle 图形标题xaxis 轴名标注plotframe 图形加框并画坐标网格线isoview 等尺寸比例显示(原图形窗口不改变)square 等尺寸比例显示(原图形窗口改变)xsetech 设置小窗口xchange 转换实数为图形象素坐标值subplot 设置多个子窗口17. 图形颜色及图形文字colormap 应用颜色图getcolor 交互式选择颜色图addcolor 增加新色于颜色图graycolormap 线性灰度图hotcolormap 热色(红到黄色)颜色图xset 图形显示方式设定xget 读当前图形显示方式设定getsymbol 交互式选择符号和尺寸18. 图形文件及图形文字xsave 将图形存储为文件xload 从磁盘中读出图形文件xbasimp 将图形按PS文件打印或存储为文件xs2fig 将图形生成Xfig 格式文件xbasc 取消图形窗及其相关内容xclear 清空图形窗driver 选择图形驱动器xinit 图形驱动器初始化xend 关闭图形xbasr 图形刷新replot 更改显示范围后的图形刷新xdel 关闭图形xname 改变当前图形窗名称19. 控制分析用图形bode 伯德图坐标gainplot 幅值图坐标(伯德图中的幅值图) nyquist 奈奎斯特图m_circle M－圆图chart 尼库拉斯图black Black－图evans 根轨迹图sgrid s 平面图plzr 零-极点图zgrid z 平面图20. 图形应用中的其它指令graphics 图形库指令表xclick 等待鼠标在图形上的点击输入locate 由鼠标点击读入图形中的多点位置坐标xgetmouse 由鼠标点击读入图形中的当前点位置坐标21. 系统与控制abcd 状态空间矩阵cont_mat 可控矩阵csim 线性系统时域响应dsimul 状态空间的离散时域响应feedback 反馈操作符flts 时域响应（离散、采样系统〕frep2tf 基于传递函数的频域响应freq 频域响应g_margin 幅值裕量imrep2ss 基于状态空间的脉冲响应lin 线性化操作lqe Kalman 滤波器lqg LQG补偿器lqr LQ补偿器ltitr 基于状态空间的离散时域响应obscont 基于观测器的控制器observer 观测器obsv_mat 观测矩阵p_margin 相位裕量phasemag 相位与幅值计算ppol 极点配置repfreq 频域响应ricc Riccati 方程rtitr 基于传递函数的离散时域响应sm2ss 系统矩阵到状态空间变换ss2ss 反馈连接的状态空间到状态空间变换ss2tf 状态空间到传递函数变换stabil 稳定性计算tf2ss 传递函数到状态空间变换time_id SISO系统最小方差辨识22. 鲁棒控制augment 被控对象增广操作bstap Hankel 矩阵近似ccontrg H∞控制器dhnorm 离散H∞范数h2norm H2 范数h_cl 闭环矩阵h_inf H∞控制器h_norm H∞范数hankelsv Hankel 矩阵奇异值leqr H∞控制器的LQ增益linf 无穷范数riccati Riccati 矩阵sensi 敏感函数23. 动态系统arma ARMA模型arma2p 基于AR模型中获得多项式矩阵armac ARMAX 辨识arsimul ARMAX系统仿真noisegen 噪声信号发生器odedi 常微分方程仿真检测prbs_a 伪随机二进制序列发生器reglin 线性拟合24. 系统与控制实例artest Arnold 动态系统bifish 鱼群人口发展的离散时域模型boucle 具有观测器的动态系统相位图chaintest 生物链模型gpech 渔业模型fusee 登陆火箭问题lotest Lorennz 吸引子mine 采矿问题obscontl可控可观系统portr3d 三维相位图portrait 二维相位图recur 双线性回归方程systems 动态系统tangent 动态系统的线性化tadinit 动态系统的交互初始化25. 非线性工具（优化与仿真〕bvode 边界值问题的常微分方程dasrt 隐式微分方程过零解dassl 代数微分方程datafit 基于测量数据的参数辨识derivative 导数计算fsolve 非线性函数过零解impl 线性微分方程int2d 二维定积分int3d 三维定积分intg 不定积分leastsq 非线性最小二乘法linpro 线性规划lmisolver 线性不等矩阵ode 常微分方程ode_discrete 离散常微分方程ode_root 常微分方程根解odedc 连续/离散常微分方程optim 非线性优化quapro 线性二次型规划semidef 半正定规划26. 多项式计算coeff 多项式系数coffg 多项式矩阵逆degree 多项式阶数denom 分母项derivat 有理矩阵求导determ 矩阵行列式值factors 因式分解hermit Hermit 型horner 多项式计算invr 有理矩阵逆lcm 最小公倍数ldiv 多项式矩阵长除numer 分子项pdiv 多项式矩阵除pol2des 多项式矩阵到表达式变换pol2str 多项式到字符串变换polfact 最小因式residu 余量roots 多项式根simp 多项式化简systmat 系统矩阵27. 信号处理%asn 椭圆积分%k Jacobi完全椭圆积分%sn Jacobi 椭圆函数analpf 模拟量低通滤波器buttmag Butterworth 滤波器响应cepstrum 倒谱计算cheb1mag Chebyshev 一型响应cheb2mag Chebyshev 二型响应chepol Chebyshev 多项式convol 卷积corr 相关, 协方差cspect 谱估计(应用相关法)dft 离散富立叶变换fft 快速富立叶变换filter 滤波器建模fsfirlin FIR滤波器设计hank 协方差矩阵到Hankel矩阵变换hilb Hilbert 变换iir IIR数字滤波器intdec 信号采样率更改kalm Kalman 滤波器更新mese 最大熵谱估计mfft 多维快速富立叶变换mrfit 频率响应拟合phc Markov 过程srkf Kalman 滤波器平方根sskf 稳态Kalman 滤波器system 观测更新wfir 线性相位FIR滤波器weiener Weiener(维纳)滤波器window 对称窗函数yulewalk 最小二乘滤波器zpbutt Buthererworth 模拟滤波器zpch1 Chebyshev 模拟滤波器28. 音频信号analyze 音频信号频域图auread 读*.au 音频文件auwrite 写*.au 音频文件lin2mu 将线性信号转换为µ率码信号loadwave 取*.wav 音频文件mapsound 音频信号图示mu2lin 将µ率码信号转换为线性信号playsnd 音频信号播放savewave 存*.wav 音频文件wavread 读*.wav 音频文件wavwrite 写*.wav 音频文件29. 语言与数据转换工具ascii 字符串的ASCII码excel2sci 读ASCII 格式的Excel 文件fun2string 将SCILAB 函数生成ASCII 码mfile2sci 将MA TLAB 的M 格式文件转换为SCI格式文件mtlb_load 取MA TLAB第4版本文件中变量matlb_save 按MA TLAB 第 4 版本文件格式存变量pol2tex 将多项式转换为TeX格式sci2for 将SCILAB 函数转换为FORTRAN格式文件texprint 按TeX 格式输出SCILAB 对象translatepaths 将子目录下的所有MA TLAB 文件转换为SCI文件格式一个公式写成Fortran语言代码program baiduinteger::I,J,Nreal*8::Cr,Treal*8,dimension(:),allocatable ::P,XN=3!变量X的个数Cr=5.0d0!常量Cr，自己设定T=4.0d0!常量T，自己设定allocate(P(N),X(N))! =======读入变量X的值do I=1,Nwrite(*,*)"请输入第",I," 个变量的值："read(*,*)X(I)enddo! =======读入变量X的值do I=1,NP(I)=(-4.2d0/Cr**2*X(I)+2.9/Cr)*Twrite(*,*)“第”,I," 个变量X对应结果：",P(I)enddoend。
(完整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常用程序
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) 该数是素数。
2.Fortran简介01
数学运算 变量
• 变量区分为整型变量INTEGER、实型变量 REAL、双精度变量DOUBLE PRECISION、 复型变量COMPLEX、逻辑型变量 LOGICAL、字符型变量CHARACTER。
数学运算 变量
• 隐含约定：Fortran规定，凡以字母I，J， K，L，M，N六个字母开头的变量名，如无 另外说明则为整型变量。以其它字母开头 的变量为实型变量。可以将这个隐含约定 称为“I—N规则” ，表示用I到N之间的字 母开头的变量为整型。例如：I，J，IMAX， NUMBER，LINE，JOB，Kl为整型变量， 而A，Bl，COUNT，AMOUNT，TOTAL， BOOK为实型变量。
数学运算 内在函数
• • • • • ABS EXP SIN COS ASIN ACOS TAN ATAN LOG LOG10 INT MOD SIGN REAL MAX MIN 注意三角函数中的自变量单位为弧度！
数学运算 算术表达式
• FORTRAN规定可以使用五种算术运算符号。 它们是： • + 表示“加”(或正号); - 表示“减”(或 负号) • * 表示“乘”; / 表示“除” • ** 表示“乘方” • 两个运算符不能紧邻，如A*-B是不合法的， 应写成A*(-B)。 • 优先次序为： 括号 >函数 > ** > * / > ＋ －
数学运算 变量
• 类型指定：如果想改变“I—N规则”，可 以用类型说明语句专门指定某些变量的类 型。 • (1)INTEGER语句(整型说明语句) • (2)REAL语句(实型说明语句) • (3)DOUBLE PRECISION语句(双精度) • (4)COMPLEX语句(复型说明语句) • (5)LOGICAL语句(逻辑型说明语句) • (6)CHARACTER语句(字符型说明语句)
fortran子程序【精选】
parameter (n1=3,n2=3,n3=3)
dimension a(n1,n2)
dimension b(n2,n3),c(n1,n3)
open(5,file='input.dat')
call getmat(a,n1,n2)
call getmat(b,n2,n3)
call matpro(a,n1,n2,b,n3,c)
20 continue end
real w(5,5) call readin(w)
输入矩阵 1,2,3,4,5 2,3,4,5,1
call opp(w,x1,x2) write(*,100) x1,x2 100 format(1x,'The two sum of',
3,4,5,1,2
$ ' oppusite angles elements:',
subroutine sub(ch) charact...er*(*) ch end
11
（4）如果实参是变量或数组元素，在调用子程序时， 对应的虚实参数实际上将共用同一存储单元。
program main
subroutine sub(x,a)
integer a,c(3)
integer x,a
data c/3*0/
4,5,1,2,3 5,1,2,3,4
$ /1x,'x1=',f8.2,' x2=',f8.2) end
9
主要区别：
1. 形式不一样（function、subroutine、call），无虚参 时括号使用不一样。
2. 子程序名的意义不一样。函数子程序名代表函数值， 通过其传递数据，需要类型说明；而子例行程序名仅 为了调用使用，通过虚实参传递数据。
第3章 Fortran程序设计初步-1(fortran77)
在FORTRAN77的基础上添
加了很多内容，FOR95只 能视为FOR90的修正版， 加强了并行运算方面的 支持功能.
5/116
NEXT
3.2 简单程序分析
10 20 30 40 50 60 70 80 01234567890123456789012345678901234567890123456789012345678901234567890123456789
3/116
3.1 FORTRAN语言发展概况
FORTRAN-Formula Translation (公式翻译) 是世界上第一个被正式推广使用的高级语言 (于1954年提出; 1956年正式使用) Fortran是数值计算领域里使用的主要语言； 发展(有代表性的几个版本)： 早期的版本不是 Fortran Ⅱ 1958 结构化语言,没 Fortran Ⅳ 1962 (Fortran 66) 有直接实现三种 基本结构的语句 Fortran 77 1978 (使用goto实现 Fortran 90 1990 特定操作).F77
35/116
FORTRAN编译系统—连接装配
36/116
FORTRAN编译系统—开始运行
37/116
FORTRAN编译系统—显示结果
38/116
FORTRAN编译系统—开始运行
FORTRAN90编译系统界面简介 FORTRAN90编译系统操作步骤 FORTRAN90编译系统基本设置等
3.3 Fortran书写格式
Fixed Format（固定格式）
第1个字符
当为字母c、C或*，这一行文本会当成说明 或批注，不会被编译。 当为数字，就是用来给这一行程序代码取 个代号，不然只能是空格。
fortran常用算法程序集
fortran常用算法程序集Fortran是一种广泛用于科学和工程计算的编程语言。
由于其强大的数值计算能力，Fortran在许多领域，如物理、数学、工程和生物信息学中，仍然被广泛使用。
在Fortran中，有许多常用的算法可以用来解决各种计算问题。
下面是一些常用的Fortran算法程序集的示例。
1.冒泡排序算法```fortranPROGRAMBubbleSortIMPLICITNONEINTEGER,DIMENSION(:),ALLOCATABLE::arrINTEGER::i,j,tempALLOCATE(arr(10))!分配数组空间!填充数组数据arr=[9,8,7,6,5,4,3,2,1,0]DOi=1,SIZE(arr)-1DOj=i+1,SIZE(arr)IF(arr(j)>arr(j-1))THEN!交换相邻元素temp=arr(j)arr(j)=arr(j-1)arr(j-1)=tempENDIFENDDOENDDOPRINT*,"排序后的数组："PRINT*,arr(:)ENDPROGRAMBubbleSort```这个程序使用冒泡排序算法对一个整数数组进行排序。
冒泡排序是一种简单的排序算法，通过重复地遍历要排序的数列，一次比较两个元素，如果他们的顺序错误就把他们交换过来。
这个算法的名字由来是因为越小的元素会经由交换慢慢“浮”到数列的顶端。
2.二分查找算法```fortranPROGRAMBinarySearchIMPLICITNONEINTEGER::arr(10),low,high,found=0INTEGER::mid=0PRINT*,"请输入要查找的元素："INPUT(INTEGER)::xlow=0high=SIZE(arr)-1DOWHILE(found==0)!直到找到元素或数组遍历完为止mid=(low+high)/2!计算中间位置IF(arr(mid)==x)THEN!如果中间元素等于要查找的元素，则找到found=1!设置found标志为1，表示找到元素ELSEIF(arr(mid)>x)THEN!如果中间元素大于要查找的元素，则在左半部分查找high=mid-1!将high指向中间元素的左边的位置ELSE!如果中间元素小于要查找的元素，则在右半部分查找low=mid+1!将low指向中间元素的右边的位置ENDIFENDDOIF(found==0)PRINT*,"元素未找到。
fortran第3章2 Fortran语言程序设计初步
【例3_1】 如果用C写了两个子程序EIGEN和eigen，然后有如下 的FROTRAN片断：
EXTERNAL EIGEN
...
CALL EIGEN
...
上一页
END
下一页
这时它是该引用EIGEN还是eigen呢？如果所使用的
停止放映
FROTRAN系统正好是怪异的那种，没问题。如果是常
见的如CVF，这时它就无法区分EIGEN和eigen，这样
有关FORTRAN 95的辅助字符集的使用规则，请参
上一页
考具体的编译系统的说明。
下一页
停止放映
3.5 词汇
所谓FORTRAN的词汇就是一个语句的最小的意义单位，它 由一个或多个FORTRAN字符集里的字符组成。包括两类共 6种，分类例举如下： ● 由文字字符组成的词汇，包括4种：
▪ 语句关键词 ▪名称 ▪由单个词汇组成的字面常量 ▪标识符
在FORTRAN90与95中：
默认在FORTRAN77中的规定, 在FORTRAN90之后的标
准里，开始允许在一个程序单元内，由用户定义特定的不
上一页
依赖于固有数据存储模式的数据类型，这就是派生数据类
下一页
型。
停止放映
第二种情况：
指定固有数据类型的种别参数。
● 用来指定程序当中需要使用的每一种固有数据类型所要 求占据的内存空间大小的属性由种别参数表示。给这个变 量(参数)指定一个数值，就可以说明数据所需要的存储空 间的大小，也就是程序允许的数值数据的位数和字符串的 字符数目。
上一页 下一页 停止放映
其中第一个为八进制数，第二个为十进制数，第三个为十六进制数。
七.下划线的涵义：
● 下划线的主要作用就是置于单词之间代替空格， 使得我们在命名时使用清楚的英语词汇。
Fortran程序设计课后习题答案方便
第四章1.program main implicit none write(*,*) "Have a good time." write(*,*) "That's not bad." write(*,*) '"Mary" isn''t my name.' end program2.program main real, parameter :: PI=3 implicit none.14159 real radius write(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积='f8. 3)") radius*radius*PI end program3.program main implicit none real grades write(*,*) "请输入成绩" read(*,*) grades write(*,"(' 调整后成绩为 'f8.3)") SQRT(grades)*10.0 end program4.integer a,b real ra,rb a=2 b=3 ra=2.0 rb=3.0 write(*,*) b/a ! 输出1, 因为使用整数计算, 小数部分会无条件舍去 write(*,*) rb/ra ! 输出1.55.p rogram main implicit none type distance real meter, inch, cm end type type(distance) :: d write(*,*) "请输入长度:" read(*,*) d%meter d%cm =d%meter*100 d%inch = d%cm/2.54 write(*,"(f8.3'米 ='f8.3'厘米 ='f8.3'英寸')")d%meter, d%cm, d%inch end program第五章1.program main implicit none integer money real tax write(*,*) "请输入月收入" read(*,*) money if ( money<1000 ) then tax = 0.03 else if( money<5000) then tax = 0.1 else tax = 0.15 end if write(*,"(' 税金为 'I8)") nint(money*tax) end program2.program main implicit none integer day character(len=20) :: tv write(*,*) "请输入星期几" read(*,*) day select case(day) case(1,4) tv= "新闻" case(2,5) tv = "电视剧" case(3,6) tv = "卡通" case(7) tv = "电影" case default write(*,*) "错误的输入" stop end select write(*,*) tv end program3.program main implicit none integer age, money real tax write(*,*) "请输入年龄" read(*,*) age write(*,*) "请输入月收入" read(*,*) money if( age<50 ) then if ( money<1000 ) then tax = 0.03 else if ( money<5000 )then tax = 0.10 else tax = 0.15 end if else if ( money<1000 ) then tax =0.5 else if ( money<5000 )then tax = 0.7 else tax = 0.10 end if end if write(*,"(' 税金为 'I8)") nint(money*tax) end program4.program main implicit none integer year, days logical mod_4, mod_100,mod_400 write(*,*) "请输入年份" read(*,*) year mod_4 = ( MOD(year,4) ==0 ) mod_100 = ( MOD(year,100) == 0 ) mod_400 = ( MOD(year,400) == 0 ) if( (mod_4 .NEQV. mod_100) .or. mod_400 ) then days = 366 else days = 365end if write(*,"('这一年有'I3'天')") days stop end program第六章1.program main implicit none integer i do i=1,5 write(*,*) "Fortran" end do stop end program2.program main implicit none integer i,sum sum = 0 do i=1,99,2 sum =sum+i end do write(*,*) sum stop end program3.program main implicit none integer, parameter :: answer = 45 integer, parameter :: max = 5 integer weight, i do i=1,max write(*,*) "请输入体重" read(*,*) weight if ( weight==answer ) exit end do if ( i<=max ) thenwrite(*,*) "猜对了" else write(*,*) "猜错了" end if stop end program4.program main implicit none integer, parameter :: max=10 integer i realitem real ans ans = 1.0 item = 1.0 do i=2,max item = item/real(i)ans = ans+item end do write(*,*) ans stop end program5.program main implicit none integer, parameter :: length = 79 character(len=length) :: input, output integer i,j write(*,*) "请输入一个字串" read(*,"(A79)") input j=1 do i=1, len_trim(input) if ( input(i:i)/= ' ' ) then output(j:j)=input(i:i) j=j+1 end if end do write(*,"(A79)") output stop end program第七章1.program main implicit none integer, parameter :: max = 10 integer i integer :: a(max) = (/ (2*i, i=1,10) /) integer :: t ! sum()是fortran库函数write(*,*) real(sum(a))/real(max) stop end program2.integer a(5,5) ! 5*5=25 integer b(2,3,4) ! 2*3*4=24 integer c(3,4,5,6) !3*4*5*6=360 integer d(-5:5) ! 11 integer e(-3:3, -3:3) ! 7*7=493.program main implicit none integer, parameter :: max=10 integer f(max) integer i f(1)=0 f(2)=1 do i=3,max f(i)=f(i-1)+f(i-2) end do write(*,"(10I4)") f stop end program4.program main implicit none integer, parameter :: size=10 integer :: a(size)= (/ 5,3,6,4,8,7,1,9,2,10 /) integer :: i,j integer :: t do i=1, size-1do j=i+1, size if ( a(i) < a(j) ) then ! a(i)跟a(j)交换 t=a(i) a(i)=a(j) a(j)=t end if end do end do write(*,"(10I4)") a stop end5.a(2,2) ! 1+(2-1)+(2-1)*(5) = 7 a(3,3) ! 1+(3-1)+(3-1)*(5) = 13第八章1.program main implicit none real radius, area write(*,*) "请输入半径长"read(*,*) radius call CircleArea(radius, area) write(*,"(' 面积 = 'F8.3)")area stop end program subroutine CircleArea(radius, area) implicit nonereal, parameter :: PI=3.14159 real radius, area area = radius*radius*PIreturn end subroutine2.program main implicit none real radius real, external :: CircleAreawrite(*,*) "请输入半径长" read(*,*) radius write(*,"(' 面积= 'F8.3)") CircleArea(radius) stop end program real function CircleArea(radius) implicit none real, parameter :: PI=3.14159 real radius CircleArea =radius*radius*PI return end function3.program main implicit none call bar(3) call bar(10) stop end program subroutine bar(length) implicit none integer, intent(in) :: length integeri character(len=79) :: string string=" " do i=1,length string(i:i)='*'end do write(*,"(A79)") string return end subroutine4.p rogram main implicit none integer, external :: add write(*,*) add(100)end program recursive integer function add(n) result(sum) implicit none integer, intent(in) :: n if ( n<0 ) then sum=0 return else if ( n<=1 )then sum=n return end if sum = n + add(n-1) return end function5.program main implicit none integer, external :: gcd write(*,*) gcd(18,12)end program integer function gcd(A,B) implicit none integerA,B,BIG,SMALL,TEMP BIG=max(A,B) SMALL=min(A,B) do while( SMALL /= 1 ) TEMP=mod(BIG,SMALL) if ( TEMP==0 ) exit BIG=SMALL SMALL=TEMP end dogcd=SMALL return end function 6.program main use TextGraphLib implicit none integer, parameter :: maxx=60, maxy=20 real, parameter :: StartX=0.0,EndX=3.14159*2.0 real, parameter :: xinc = (EndX-StartX)/(maxx-1) real x integer i,px,py call SetScreen(60,20) call SetCurrentChar('*') x=StartXdo px=1,maxx py = (maxy/2)*sin(x)+maxy/2+1 call PutChar(px,py) x=x+xincend docall UpdateScreen() stop end program第九章1.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer count integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old")count = 0 do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status )buffer if ( status/=0 ) exit ! 没有资料就跳出循环 write(*,"(A79)")buffer count = count+1 if ( count==24 ) then pause count = 0 endif end do else write(*,*) TRIM(filename)," doesn't exist." end ifstop end2.p rogram main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer iinteger :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)") filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old")do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) bufferif ( status/=0 ) exit ! 没有资料就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-3 ) end do write(*,"(A70)") bufferend do else write(*,*) TRIM(filename)," doesn't exist." end if stop end3.program main implicit none type student integer chinese, english, math, science, social, total end type type(student) :: s, total integer, parameter :: students=20, subjects=5 integer i open(10,file="grades.bin",access="direct",recl=1) write(*,"(7A10)") "座号","中文","英文","数学","自然","社会","总分" total = student(0,0,0,0,0,0) do i=1, students read(10,rec=(i-1)*subjects+1) s%chinese read(10,rec=(i-1)*subjects+2) s%english read(10,rec=(i-1)*subjects+3) s%math read(10,rec=(i-1)*subjects+4) s%science read(10,rec=(i-1)*subjects+5)s%social s%total = s%chinese+s%english+s%math+s%science+s%social total%chinese= total%chinese+s%chinese total%english = total%english+s%english total%math =total%math+s%math total%science = total%science+s%science total%social =total%social+s%social total%total = total%total+s%total write(*,"(7I10)") i,s end do write(*,"(A10,6F10.3)") "平均", & real(total%chinese)/real(students),&real(total%english)/real(students),& real(total%math)/real(students),& real(total%science)/real(students),&real(total%social)/real(students),& real(total%total)/real(students)stop end 4.program main implicit none character(len=79) :: filename character(len=79) :: buffer integer, parameter :: fileid = 10 integer i integer :: status = 0 logical alive write(*,*) "Filename:" read (*,"(A79)")filename inquire( file=filename, exist=alive) if ( alive ) then open(unit=fileid, file=filename, & access="sequential", status="old") do while(.true.) read(unit=fileid, fmt="(A79)", iostat=status ) buffer if ( status/=0 ) exit ! 没有数据就跳出循环do i=1, len_trim(buffer) buffer(i:i) = char( ichar(buffer(i:i))-(mod(i-1,3)+1) ) end do write(*,"(A70)") buffer end do else write(*,*) TRIM(filename)," doesn't exist." end if stop end5.module typedef type student integer :: num integer :: Chinese, English, Math, Natural, Social integer :: total integer :: rank end type end module program main use typedef implicit none integer, parameter :: fileid=10 integer, parameter :: students=20 character(len=80) :: tempstr type(student) :: s(students) ! 储存学生成绩 type(student) :: total ! 计算平均分数用integer i, num, error open(fileid,file="grades.txt",status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open grades.txt fail." stop end if read(fileid, "(A80)") tempstr ! 读入第一行文字 total=student(0,0,0,0,0,0,0,0) ! 用循环读入每位学生的成绩do i=1,students read(fileid,*) s(i)%num, s(i)%Chinese,s(i)%English, & s(i)%Math, s(i)%Natural, s(i)%Social ! 计算总分 s(i)%Total = s(i)%Chinese + s(i)%English + & s(i)%Math +s(i)%Natural + s(i)%Social ! 累加上各科的分数, 计算各科平均时使用total%Chinese = total%Chinese + s(i)%Chinese total%English = total%English +s(i)%English total%Math = total%Math + s(i)%Math total%Natural = total%Natural + s(i)%Natural total%Social = total%Social + s(i)%Social total%Total = total%Total + s(i)%Total end do call sort(s,students) ! 重新输出每位学生成绩 write(*,"(8A7)") "座号","中文","英文","数学","自然","社会","总分","名次" do i=1,students write(*,"(8I7)") s(i) end do ! 计算并输出平圴分数write(*,"(A7,6F7.1)") "平均", &real(total%Chinese)/real(students),& real(total%English)/real(students),&real(total%Math) /real(students),& real(total%Natural)/real(students),&real(total%Social) /real(students),& real(total%Total) /real(students) stop end program subroutine sort(s,n) use typedef implicit none integer n type(student) :: s(n), t integer i,j do i=1,n-1 do j=i+1,n if( s(i)%total < s(j)%total ) then t = s(i) s(i)=s(j) s(j) = t end ifend do end do forall(i=1:n) s(i)%rank = i end forall end subroutine第十章1.integer(kind=4) :: a ! 4 bytes real(kind=4) :: b ! 4 bytes real(kind=8) :: c !8 bytes character(len=10) :: str ! 10 bytes integer(kind=4), pointer :: pa !4 bytes real(kind=4), pointer :: pb ! 4 bytes real(kind=8), pointer :: pc !4 bytes character(len=10), pointer :: pstr ! 4 bytes type student integer Chinese, English, Math end type type(student) :: s ! 12 bytes type(student), pointer ::ps ! 4 bytes2.integer, target :: a = 1 integer, target :: b = 2 integer, target :: c = 3 integer, pointer :: p p=>a write(*,*) p ! 1 p=>b write(*,*) p ! 2 p=>c p=5 write(*,*) c !53.module linklist type student integer :: num integer :: Chinese, English,Math, Science, Social end type type datalink type(student) :: item type(datalink), pointer :: next end type contains function SearchList(num, head) implicit none integer :: num type(datalink), pointer :: head, p type(datalink), pointer :: SearchList p=>head nullify(SearchList) do while( associated(p) ) if ( p%item%num==num ) then SearchList => p return end if p=>p%next end do return end function end module linklist programex1016 use linklist implicit none character(len=20) :: filename character(len=80) :: tempstr type(datalink), pointer :: head type(datalink), pointer :: p type(student), allocatable :: s(:) integer i,error,size write(*,*) "filename:" read(*,*) filename open(10, file=filename, status="old", iostat=error) if ( error/=0 ) then write(*,*) "Open file fail!" stop end if allocate(head) nullify(head%next) p=>head size=0 read(10, "(A80)") tempstr ! 读入第一行字符串, 不需要处理它 ! 读入每一位学生的成绩 do while(.true.) read(10,fmt=*, iostat=error) p%item if ( error/=0 )exit size=size+1 allocate(p%next, stat=error) ! 新增下一个数据 if ( error/=0 )then write(*,*) "Out of memory!" stop end if p=>p%next ! 移动到链表的下一个数据 nullify(p%next) end do write(*,"('总共有',I3,'位学生')") size allocate( s(size) ) p=>head do i=1,size s(i)=p%item p=>p%next end do do while(.true.) write(*,*) "要查询几号同学的成绩?" read (*,*) i if( i<1 .or. i>size ) exit ! 输入不合理的座号 write(*,"(5(A6,I3))") "中文",s(i)%Chinese,& "英文",s(i)%English,& "数学",s(i)%Math,& "自然",s(i)%Science,& "社会",s(i)%Social end do write(*,"('座号',I3,'不存在, 程序结束.')") i stopend program4.module typedef implicit none type :: datalink integer :: i type(datalink), pointer :: next end type datalink end module typedef programex1012 use typedef implicit none type(datalink) , pointer :: p, head, next integer :: i,n,err write(*,*) 'Input N:' read(*,*) n allocate( head ) head%i=1 nullify(head%next) p=>head do i=2,n allocate( p%next,stat=err ) if ( err /= 0 ) then write(*,*) 'Out of memory!' stop end if p=>p%next p%i=i end do nullify(p%next) p=>head do while(associated(p)) write(*, "(i5)" ) p%i p=>p%next end do ! 释放链表的存储空间p=>head do while(associated(p)) next => p%next deallocate(p) p=>next end do stop end program第十一章1.module utility implicit none interface area module procedure CircleArea module procedure RectArea end interface contains real function CircleArea(r) real, parameter :: PI=3.14159 real r CircleArea =r*r*PI return end function real function RectArea(a,b) real a,b RectArea = a*b return end function end module program main use UTILITY implicit none write(*,*) area(1.0) write(*,*) area(2.0,3.0) stop end program2.module time_utility implicit none type :: time integer :: hour,minute,second end type time interface operator(+) module procedureadd_time_time end interface contains function add_time_time( a, b ) implicit none type(time) :: add_time_time type(time), intent(in) :: a,binteger :: seconds,minutes,carry seconds=a%second+b%second carry=seconds/60 minutes=a%minute+b%minute+carry carry=minutes/60add_time_time%second=mod(seconds,60) add_time_time%minute=mod(minutes,60)add_time_time%hour=a%hour+b%hour+carry return end function add_time_time subroutine input( a ) implicit none type(time), intent(out) :: a write(*,*) " Input hours:" read (*,*) a%hour write(*,*) " Input minutes:"read (*,*) a%minute write(*,*) " Input seconds:" read (*,*) a%second return end subroutine input subroutine output( a ) implicit nonetype(time), intent(in) :: a write(*, "(I3,' hours',I3,' minutes',I3,'seconds')" ) a%hour,a%minute,a%second return end subroutine output endmodule time_utility program main use time_utility implicit nonetype(time) :: a,b,c call input(a) call input(b) c=a+b call output(c)stop end program main3.module rational_utility implicit none private public :: rational, & operator(+), operator(-), operator(*),& operator(/), assignment(=),operator(>),& operator(<), operator(==),operator(/=),& output, input type :: rational integer :: num,denom end type rational interface operator(+) module procedurerat__rat_plus_rat end interface interface operator(-) module procedurerat__rat_minus_rat end interface interface operator(*) module procedurerat__rat_times_rat end interface interface operator(/) module procedurerat__rat_div_rat end interface interface assignment(=) module procedurerat_eq_rat module procedure int_eq_rat module procedure real_eq_rat endinterface interface operator(>) module procedure rat_gt_rat endinterface interface operator(<) module procedure rat_lt_rat endinterface interface operator(==) module procedure rat_compare_rat endinterface interface operator(/=) module procedure rat_ne_rat endinterface contains function rat_gt_rat(a,b) implicit none logical ::rat_gt_rat type(rational), intent(in) :: a,b real :: fa,fbfa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom) if ( fa > fb )then rat_gt_rat=.true. else rat_gt_rat=.false. end if return end function rat_gt_rat function rat_lt_rat(a,b) implicit none logical :: rat_lt_rat type(rational), intent(in) :: a,b real :: fa,fbfa=real(a%num)/real(a%denom) fb=real(b%num)/real(b%denom) if ( fb > fa )then rat_lt_rat=.true. else rat_lt_rat=.false. end if return end function rat_lt_rat function rat_compare_rat(a,b) implicitnone logical :: rat_compare_rat type(rational), intent(in) :: a,btype(rational) :: c c=a-b if ( c%num == 0 ) thenrat_compare_rat=.true. else rat_compare_rat=.false. end if return end function rat_compare_rat function rat_ne_rat(a,b) implicitnone logical :: rat_ne_rat type(rational), intent(in) :: a,btype(rational) :: c c=a-b if ( c%num==0 ) then rat_ne_rat=.false.else rat_ne_rat=.true. end if return end function rat_ne_rat subroutine rat_eq_rat( rat1, rat2 ) implicit none type(rational),intent(out):: rat1 type(rational), intent(in) :: rat2 rat1%num =rat2%num rat1%denom = rat2%denom return end subroutine rat_eq_ratsubroutine int_eq_rat( int, rat ) implicit none integer, intent(out):: inttype(rational), intent(in) :: rat int = rat%num / rat%denom return end subroutine int_eq_rat subroutine real_eq_rat( float, rat ) implicit none real, intent(out) :: float type(rational), intent(in) :: rat float =real(rat%num) / real(rat%denom) return end subroutine real_eq_rat function reduse( a ) implicit none type(rational), intent(in) :: a integer :: b type(rational) :: reduse b=gcv_interface(a%num,a%denom) reduse%num = a%num/b reduse%denom = a%denom/b return end function reduse function gcv_interface(a,b) implicit none integer, intent(in) ::a,b integer :: gcv_interface if ( min(a,b) .eq. 0 ) then gcv_interface=1 return end if if (a==b) then gcv_interface=a return else if ( a>b ) then gcv_interface=gcv(a,b) else if ( a<b ) then gcv_interface=gcv(b,a) end if return end function gcv_interface recursive function gcv(a,b) result(ans) implicitnone integer, intent(in) :: a,b integer :: m integer :: ans m=mod(a,b) select case(m) case(0) ans=b return case(1) ans=1 return case default ans=gcv(b,m) end select return end function gcv function rat__rat_plus_rat( rat1, rat2 ) implicitnone type(rational) :: rat__rat_plus_rat type(rational), intent(in) ::rat1,rat2 type(rational) :: act act%denom= rat1%denom * rat2%denom act%num = rat1%num*rat2%denom + rat2%num*rat1%denom rat__rat_plus_rat = reduse(act) return end function rat__rat_plus_rat functionrat__rat_minus_rat( rat1, rat2 ) implicit none type(rational) ::rat__rat_minus_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom*rat2%denom temp%num =rat1%num*rat2%denom - rat2%num*rat1%denom rat__rat_minus_rat = reduse( temp ) return end function rat__rat_minus_rat function rat__rat_times_rat( rat1,rat2 ) implicit none type(rational) :: rat__rat_times_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%denom temp%num = rat1%num * rat2%num rat__rat_times_rat = reduse(temp) return end function rat__rat_times_rat function rat__rat_div_rat( rat1, rat2 ) implicit none type(rational) ::rat__rat_div_rat type(rational), intent(in) :: rat1, rat2 type(rational) :: temp temp%denom = rat1%denom* rat2%num temp%num =rat1%num * rat2%denom rat__rat_div_rat = reduse(temp) return end function rat__rat_div_rat subroutine input(a) implicit none type(rational), intent(out) :: a write(*,*) "分子:" read(*,*) a%num write(*,*) "分母:" read(*,*) a%denom return end subroutine input subroutine output(a) implicit none type(rational), intent(in) :: a if ( a%denom/=1 ) then write(*, "(' (',I3,'/',I3,')' )" ) a%num,a%denom else write(*, "(I3)" ) a%num end if return end subroutine outputend module rational_utility program main use rational_utility implicit none type(rational) :: a,b,c call input(a) call input(b) c=a+b write(*,*)"a+b=" call output(c) c=a-b write(*,*) "a-b=" call output(c) c=a*b write(*,*) "a*b=" call output(c) c=a/b write(*,*) "a/b=" call output(c)if (a>b) write(*,*) "a>b" if (a<b) write(*,*) "a<b" if (a==b) write(*,*) "a==b"if (a/=b) write(*,*) "a/=b" stop end program main4.module vector_utility implicit none type vector real x,y end type interface operator(+) module procedure vector_add_vector end interface interface operator(-) module procedure vector_sub_vector end interface interface operator(*) module procedure real_mul_vector module procedure vector_mul_real module procedure vector_dot_vector end interface interface operator(.dot.) module procedure vector_dot_vector end interface contains type(vector) function vector_add_vector(a,b) type(vector), intent(in) :: a,b vector_add_vector = vector(a%x+b%x, a%y+b%y) end function type(vector) function vector_sub_vector(a,b) type(vector), intent(in) :: a,b vector_sub_vector = vector(a%x-b%x, a%y-b%y) end function type(vector) function real_mul_vector(a,b) real, intent(in) :: a type(vector), intent(in) :: b real_mul_vector = vector( a*b%x, a*b%y ) end functiontype(vector) function vector_mul_real(a,b) type(vector), intent(in) :: a real, intent(in) :: b vector_mul_real = real_mul_vector(b,a) end function real function vector_dot_vector(a,b) type(vector), intent(in) :: a,b vector_dot_vector = a%x*b%x + a%y*b%y end function subroutine output(vec) type(vector) :: vec write(*,"('('F6.2','F6.2')')") vec end subroutine end module program main use vector_utility implicit none type(vector) a,b,ca=vector(1.0, 2.0) b=vector(2.0, 1.0) c=a+b call output(c) c=a-b call output(c) write(*,*) a*b end program main。
fortran程序汇总
计算圆周率REAL R,R1,R2,PIISEED=RTC()N0=0N=300000DO I=1,NR1=RAN(ISEED)R2=RAN(ISEED)R=SQRT(R1*R1+R2*R2)IF(R<1.0)N0=N0+1END DOPI=4.0*N0/NWRITE(*,*)PIEND一）蒙特卡洛计算生日问题假设有N个人在一起，各自的生日为365天之一，根据概率理论，与很多人的直觉相反，只需23个人便有大于50％的几率人群中至少有2个人生日相同。
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 DIFFUSION 蒙特卡罗计算一维扩散问题INTEGER 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三维的！三）通过该程序了解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模拟一个晶粒的缩小USE MSFLIBPARAMETER IR=400,JR=400INTEGER IS(0:IR+1,0:JR+1),TMAX,ISN(1:8),NSTATE,T,NR,IX,IY WRITE(*,*)"PLEASE INPUT THE TIME STEP "READ(*,*)TMAXISEED=RTC()! 定义圆心和半径IRC=IR/2JRC=IR/2R=MIN(IRC,JRC)-10! 定义基体和圆晶粒分别为状态1、状态2IS=1DO I=1,IRDO J=1,JRDISTANCE=SQRT(1.0*(I-IRC)**2+1.0*(J-JRC)**2)IF(DISTANCE.LT.R)IS(I,J)=2ISE=SETCOLOR(IS(I,J))ISE=SETPIXEL(I,J)END DOEND DOOPEN(1,FILE="E:\LUKE.DAT")! 寻找晶粒边界，计算能量，改变状态。
fortran90例子
fortran90例子例1、输入M个实数，将其相加，并输出其和。
PROGRAM example_1Implicit noneInteger ::n,mReal ::t=0,a=0Read *,mDoRead *， aT=t+aN=n+1If (n>=m) exitEnd doPrint*,tEnd program example_1例2、求∑I!的阶乘（I=4,8）。
Function factor(n) result(fac_result) Implicit noneInteger ,intent(in)::nInteger,intent(out)::fac_resultInteger::IFac_result=1Do I=1,nFac_result=fac_result*IEnd doEnd function factorProgram example_2Implicit noneInteger ::factor,s=0,IDo I=4,8S=s+factor(i)End doPrint*,sEnd program example_2例3、输入一个数，判断他是否能被3整除，并输出相应的信息。
Program judgeImplicit noneInteger :: n,mRead*,nM=mod(n,3)Select case(m) IF (M= =0) THENCase (0)Print*,’yes’Print*,’YES’Case default ELSEPrint*,’no’Print*,’NO’End select END IFEnd program judge例4、判断一个整数N是否为素数PROGRAM primeImplicit noneInteger ::n,I,mRead*,nM= sqrt(real(n))Do I=2,mIf(mod(n,i)= =0) exitEnd doIf (I>m) thenPrint*,’yes’ElsePrin t*,’no’end ifend program prime例5、求N的阶乘PROGRAM example_5Implicit noneInteger::n,I=0,fac=1Read*,nDo while (I<7)I=I+1Fac=fac*IEnd doEnd program example_5例6、求出全部的水仙花数。
Fortran编程必备参考
/share/detail/24946126Just as in Basic we use TAB and PRINT USING commands to more precisely control program output, in Fortran we can usewrite commands with format statements. While these can get complicated, the most commonly used options are pretty easy to use. A typical write statement iswrite (*,20) x, y, z .The "*" in the parentheses instructs Fortran to write to the screen, while "20" refers to the label ofthe format statement for thiswrite command. The x, y, and z are the variables to be printed.A format statement for this write command might be20 format (3f10.4) .Inside the parentheses, the "3" indicates that 3 entities will be printed, the "f" denotes that these willbe floating point real numbers (not exponential notation), the "10" stipulates that 10 places will be used for printing (counting the sign, decimal point, and the digits), and ".4" mandates 4 digits after the decimal point. Some printouts formatted this way are12345.6789 , -1234.5678 , 10002.3400 .The letter "f" in this context is a format code letter; here are some of the more commonly used format code letters, with their implications:f real number, floating point formate single precision real number, exponential notationd double precision real number, exponential notationi integera text string (character)x space/vertical space (line feed)t tab indicatorStrings (in quotes) may be placed in format statements, separated by commas. Here are examples of write statements with corresponding format statements; at the right of each is a description of the corresponding output:write (*,10) n, x, y10 format (i4,4x,f10.4,2x,f10.4)integer n printed using 4 places, then 4 spaces, then real numbers x and y printed with 2 spaces between, each using 10 places and 4 decimal placeswrite (*,20) area20 format ("The area is ",f8.5)string in quotes is printed, then the real number area is printed, using 8 places with 5 decimal placeswrite (*,30) "The area is ", area30 format (a,f8.5)same output as immediately abovewrite (*,40) x, y, z 40 format (3d20.14)3 double precision numbers x, y, z printed, each reserving 20 spaces, with 14 decimal placeswrite (*,50) student, score 50 format (a20,4x,i3)student, a text string up to 20 characters, is printed, then 4 spaces, then score, an integer using a maximum of 3 placeswrite (*,60) r, A60 format (t10,f4.2,/,t10,f6.2)tabs to column 10, prints real number r, goes to next line, tabs to column 10, prints real number AYou can use loops with format statements to print arrays; here are examples:do i = 1, 10 write (*,70) a(i) end do an array a of real numbers, indexed from 1 to 10, is printed; each entry occupies 5 places with70 format (f5.2) 2 decimal places, and is printedon a separate linewrite (*,80) (a(i), i = 1, 10)80 format (f5.2)same output as immediately abovewrite (*,90) (a(i), i = 1, 10) 90 format (10f5.2)same output as above, except that all entries are printed on the same linedo i = 1, 5write (*,7) (m(i,j), j = 1, 6) 7 format (6i3)end do prints a 5 x 6 two-dimensional array m of integers, with each integer entry m(i,j) occupying 3 places. Each row of the matrix appears on its own line.Following are examples of stored values, formatting specifications for printing the values, and resulting output. (The "^" symbol indicates a blank).Stored Value Format Specifier Output1.234567f8.2^^^^1.230.00001f5.30.000-12345i5*****-12345i6-1234512345i6^123450.00001234e10.3^0.123E-040.0001234e12.4^^0.1234E-031234567.89e9.2^0.12E+07aloha a8^^^aloha1.23456789123D0d17.10^0.1234567891E+01 Fortran format格式说明2. 字符返回。
Fortran学习过程中写的一些小程序
Fortran学习过程中写的一些小程序1，多重循环的判断program ex19implicit noneinteger scorecharacter gradewrite(*,*) "score："read(*,*) scoreif (score>100) thengrade="?"else if (score>=90) thengrade="A"else if (score>=80) thengrade='B'else if (score>=70) thengrade='C'else if (score>=60) thengrade='D'elsegrade="?"end ifwrite(*,*) gradestopendprogram ex19implicit noneinteger scorecharacter gradewrite(*,*) "score："read(*,*) scoreif (score>=90.and.score<=100) thengrade="A"else if (score>=80.and.score<90) thengrade="B"else if (score>=70.and.score<90) thengrade='C'else if (score>=60.and.score<70) then grade='D'else if (score>=50.and.score<60) then grade='E'elsegrade="F"end ifwrite(*,*) gradestopendprogram ex19implicit nonereal xreal yinteger answrite(*,*) "请输入坐标：(x,y)" read(*,*) x,yif (x>0) thenif (y>0) thenans=1else if (y<0) thenans=4elseans=0end ifelse if (x<0) thenif (y>0) thenans=2else if (y<0) thenans=3elseans=0end ifelseans=0end ifif (ans/=0) thenwrite(*,"('第',I1,'象限')") anselsewrite(*,*) "在坐标轴上"end ifstopendprogram ex11implicit nonecharacter::str1,str2character relationwrite(*,*) "string1="read(*,*) str1write(*,*) "string2="read(*,*) str2if (str1>str2) thenrelation=">"else if (str1==str2) thenrelation="="elserelation="<"end ifwrite(*,"('string1',A1,'string2')") relationstopendprogram ex11implicit noneinteger ywrite(*,*) "y="read(*,*) yif(mod(y,4)==0.and.mod(y,100)/=0.and.mod(y,400)==0) then write(*,*) "闰年"elsewrite(*,*) "不是闰年"end ifstopendprogram mainimplicit noneinteger,parameter::dest=9 integer floordo floor=1,destif (floor==4) cyclewrite(*,*) floorend dostopendprogram mainimplicit nonereal,parameter::weight=45.0 real,parameter::error=0.001real gaussdo while(abs(gauss-weight)>error) write(*,*) "weight="read(*,*) gaussend dowrite(*,*) "weight=",gaussstopendprogram mainimplicit noneinteger i,jloop1:do i=1,3loop2:do j=1,3if(i==3) exit loop1if(j==2) cycle loop2write(*,"('(',i2,',',i2,')')") i,jend do loop2end do loop1stopendprogram mainimplicit noneinteger::fn2=0integer::fn1=1integer::fn=0integer counterwrite(*,*) fn2write(*,*) fn1do counter=2,9fn=fn2+fn1write(*,"(I3)") fnfn2=fn1fn1=fnend dostopendprogram mainimplicit noneinteger iinteger,parameter::key=2integer lenstrcharacter(len=20)::stringwrite(*,*) "string:"read(*,*) stringlenstr=len(trim(string))do i=1,lenstrstring(i:i)=char(ichar(string(i:i))+key) end dowrite(*,*) stringstopendprogram mainimplicit nonereal i,j,ki=1j=1k=0do i=1,3j=j/i !计算每个的阶乘k=k+j !计算阶乘的和end dowrite(*,*) kstopendprogram mainimplicit noneinteger,parameter::classes=5integer,parameter::students=5integer::student(classes,students)integer c,sdo c=1,classesdo s=1,studentswrite(*,"('number',I2'of classes',I2)") c,s read(*,*) student(c,s)end doend dodo while(.true.)write(*,*) "classes:"read(*,*) cif(c<=0.or.c>classes) exitwrite(*,*) "student:"read(*,*) sif(s<=0.or.s>students) exitwrite(*,*) student(c,s)end dostopend数组program mainimplicit noneinteger,parameter::row=2integer,parameter::col=2integer::m(row,col)integer r,cdata((m(r,c),r=1,2),c=1,2)/1,2,3,4/write(*,"(I3,I3/I3,I3)") ((m(r,c),r=1,2),c=1,2)stopendprogram mainimplicit noneinteger::i,jinteger,parameter::size=10 integer::a(size)=(/1,10,5,4,3,6,9,8,7,2/) integer::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(*,*) astopendprogram mainimplicit noneinteger::a(4)integer binteger i,jread(*,*) ado i=1,3do j=i+1,4if (a(i)<a(j)) thenb=a(i)a(i)=a(j)a(j)=bend ifend doend dowrite(*,*) astopendprogram mainimplicit noneinteger::iinteger,parameter::players=5real::angle(players)=(/45,50,55,40,35/) real::speed(players)=(/25,20,21,22,27/) real::distance(players)do i=1,playerscall get_distance(angle(i),speed(i),distance(i)) write(*,"('player',I2,'=',F8.2)") I,distance(i) end dostopendsubroutine angle_to_rad(angle,rad)implicit nonereal,parameter::pi=3.14159real::angle,radrad=angle*pi/180.0endsubroutine get_distance(angle,speed,distance) implicit nonereal speed,angle,distancereal t,Vx,radreal,parameter::G=9.8call angle_to_rad(angle,rad)t=2*speed*sin(rad)/GVx=speed*cos(rad)distance=t*Vxendprogram mainimplicit noneinteger,parameter::players=5real::angle(players)=(/30.0,45.0,35.0,50.0,40.0/) real::speed(players)=(/25.0,20.0,21.0,27.0,22.0/) real::distance(players)real,external::get_distanceinteger::ido i=1,playersdistance(i)=get_distance(angle(i),speed(i))write(*,"('player',I2,'='F8.2)") i, distance(i) end dostopendreal function angle_to_rad(angle)implicit nonereal anglereal,parameter::pi=3.14159angle_to_rad=angle*pi/180.0returnendreal function get_distance(speed,angle) implicit nonereal speedreal anglereal timereal Vxreal radreal,parameter::g=9.81real,external::angle_to_radrad=angle_to_rad(angle)time=2*speed*sin(rad)/gVx=speed*cos(rad)get_distance=Vx*timereturnendprogram mainimplicit noneinteger i,ninteger::left=0integer rightwrite(*,*) "n="read(*,*) ndo i=1,nleft=left+i**2end doright=n*(n+1)*(2*n+1)/6if (left==right) thenwrite(*,*) "正确"elsewrite(*,*) "不正确"end ifstopendprogram mainimplicit noneinteger a,binteger tmp,tmp1,tmp2 integer gcd,lcmwrite(*,*) "请输入a,b的值" read(*,*) a,bif (a<b) thentmp=aa=bb=tmpend iftmp1=atmp2=btmp=mod(a,b)do while (.true.)if (tmp==0) exittmp1=tmp2tmp2=tmptmp=mod(tmp1,tmp2)end dogcd=tmp2lcm=a*b/gcdwrite(*,*) gcd,lcmstopendprogram mainimplicit noneinteger ireal numinteger::num1=0integer::num2=0integer::num3=0real::score,meanscorereal::sumscore=0.0write(*,*) "请输入学生人数：" read(*,*) numdo i=1,numwrite(*,"('第',I2,'个同学的成绩：')") i read(*,*) scoresumscore=sumscore+scoreif (score>60) thennum1=num1+1else if(score==60) thennum2=num2+1elsenum3=num3+1end ifend domeanscore=sumscore/numwrite(*,*) "及格以上人数：",num1write(*,*) "刚好及格人数：",num2write(*,*) "不及格的人数：",num3write(*,*) "平均分为：",meanscorestopendprogram mainimplicit noneinteger ninteger,external::factwrite(*,*) "N="read(*,*) nwrite(*,"(I2,'!=',I8)") n,fact(n)stopendrecursive integer function fact(n) result(ans) implicit noneinteger,intent(in)::nif (n<0) thenans=-1returnelse if (n<=1) thenans=1returnend ifans=n*fact(n-1)returnendprogram mainimplicit noneinterfacefunction random10(lbound,ubound)real::lbound,uboundreal::random10(10)end functionend interfacereal::a(10)call random_seed()a=random10(1.0,10.0)write(*,*) aendfunction random10(lbound,ubound) implicit nonereal::lbound,uboundreal::lenreal::random10(10)real tinteger ilen=ubound-lbounddo i=1,10call random_number(t)random10(i)=lbound+len*t end doreturnendmodule constantimplicit nonereal,parameter::pi=3.14159real,parameter::g=9.81end modulemodule typedefimplicit nonetype playerreal::anglereal::speedreal::distanceend typeend moduleprogram mainuse typedefimplicit noneinteger,parameter::players=5type(player)::people(players)=(/player(30.0,25.0,0.0),&player(45.0,20.0,0.0),&player(35.0,21.0,0.0),&player(50.0,27.0,0.0),&player(40.0,22.0,0.0)&/)real,external::get_distanceinteger ido i=1,playerscall get_distance(people(i))write(*,"('player',I1,'=',F8.2)") i,people(i)%distanceend dostopendreal function angle_to_rad(angle)use constantimplicit nonereal angleangle_to_rad=angle*pi/180returnendsubroutine get_distance(person)use constantuse typedefimplicit nonetype(player)::personreal rad,Vx,timereal,external::angle_to_radrad=angle_to_rad(person%angle)Vx=person%speed*cos(rad)time=2*person%speed*sin(rad)/gperson%distance=Vx*timereturnend。
Fortran程序总结
1.行的书写(行的长度、分行、续行)一行可以是0~132个字符，空格有意义，语句最长不超过2640个字符一行可以有多个语句，用“;”分隔一个语句可分行写，读行标记为&（放在尾部），但如为关键字，首尾均加&。
最多可有511个续行。
2.说明语句必须出现在可执行语句之前，格式说明语句（FORMAT语句）除外。
3.注释标志符：自由格式：！固定格式：C *语句分隔符：分号；（仅自由格式可以使用）续行符：自由格式：&申明标号： 1到5位无符号整数空格：关键字、变量、常量内部不能用空格，但相邻两者之间须用空格4.信息处理的分类：数值处理和信息处理现代计算机工作原理：程序存储和程序控制（冯·诺依曼）1、运算器——算术运算、逻辑运算2、控制器——根据指令控制计算机工作运算器、控制器和寄存器称为中央处理器CPU3、I/O设备——提供数据传输服务4、总线——数据传输的公共通道1.机器语言：二进制代码形式，可以被计算机直接执行，不可移植2.汇编语言：用助记符来代替机器指令，容易记忆，不可移植3.高级语言：接近自然语言（英语）的程序设计语言，又称算法语言，易学、易用、易维护，可移植性好例：FORTRAN、BASIC、PASCAL、C、LISP、PROLOG 等5.FORTRAN90程序是一种分块结构，由若干个程序单元块组成：主程序、外部子程序、模块、块数据单元无论是主程序单元，还是子程序单元，都是独立的程序单位，应该独立编写，它们的形式相似。
非语句行：注释语句：！后的所有字符都被编译器忽略。
可独占一行，也可在其它语句之后，空行为注释行（固定格式用C和*）6.常量的定义：常量是程序执行过程中不能变化的量。
基本数据类型有五种：整型、实型、复型、字符型和逻辑型前三种属于数值类型，后两种为非数值类型，主要用于文字处理和控制。
FORTRAN 90通过KIND值确定整数的存储开销、最大位数和取值范围，如表所示。
(完整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可用的FFT代码
快速傅立叶变换(FFT)的FORTRAN程序代码虽然现在网上的FFT程序很多，但是有的结果是错误的，比如说，经过一次正反变换后，不能得到原来的数列，所以，本人测试了多个程序，提供几个能用的，给大家，希望大家支持！SUBROUTINE FOUR1(DATA,NN,ISIGN)! ISIGN: -1:反变换1：正变换REAL*8 WR, WI, WPR, WPI, WTEMP, THETADIMENSION DATA(2*NN)N = 2*NNJ = 1DO 11 I = 1, N, 2IF(J.GT.I) THENTEMPR = DATA(J)TEMPI = DATA(J+1)DATA(J) = DATA(I)DATA(J+1) = DATA(I+1)DATA(I) = TEMPRDATA(I+1) = TEMPIEND IFM = N / 21 IF((M.GE.2).AND.(J.GT.M)) THENJ = J - MM = M / 2GO TO 1END IFJ = J + M11 CONTINUEMMAX = 22 IF(N.GT.MMAX) THENISTEP = 2 * MMAXTHETA = 6.28318530717959D0 / (ISIGN*MMAX)WPR = -2.D0 * DSIN(0.5D0*THETA)**2WPI = DSIN(THETA)WR = 1.D0WI = 0.D0DO 13 M = 1, MMAX, 2DO 12 I = M, N, ISTEPJ = I + MMAXTEMPR = SNGL(WR) * DATA(J) - SNGL(WI) * DATA(J+1)TEMPI = SNGL(WR) * DATA(J+1) + SNGL(WI) * DATA(J)DATA(J) = DATA(I) - TEMPRDATA(J+1) = DATA(I+1) - TEMPIDATA(I) = DATA(I) + TEMPRDATA(I+1) = DATA(I+1) + TEMPI12 CONTINUEWTEMP = WRWR = WR * WPR - WI * WPI + WRWI = WI * WPR + WTEMP * WPI + WI13 CONTINUEMMAX = ISTEPGO TO 2END IFRETURNEND这个程序也很不错！c-------------------------------------------------------------cc cc Subroutine sffteu( x, y, n, m, itype ) cc cc This routine is a slight modification of a complex split cc radix FFT routine presented by C.S. Burrus. The original cc program header is shown below. cc cc Arguments: cc x - real array containing real parts of transform cc sequence (in/out) cc y - real array containing imag parts of transform cc sequence (in/out) cc n - integer length of transform (in) cc m - integer such that n = 2**m (in) cc itype - integer job specifier (in) cc itype .ne. -1 --> foward transform cc itype .eq. -1 --> backward transform cc cc The forward transform computes cc X(k) = sum_{j=0}^{N-1} x(j)*exp(-2ijk*pi/N) cc cc The backward transform computes cc x(j) = (1/N) * sum_{k=0}^{N-1} X(k)*exp(2ijk*pi/N) cc cc cc Requires standard FORTRAN functions - sin, cos c c cc Steve Kifowit, 9 July 1997 cc cC-------------------------------------------------------------CC A Duhamel-Hollman Split-Radix DIF FFT C C Reference: Electronics Letters, January 5, 1984 C C Complex input and output in data arrays X and Y C C Length is N = 2**M CC CC C.S. Burrus Rice University Dec 1984 C C-------------------------------------------------------------CcSUBROUTINE SFFTEU( X, Y, N, M, ITYPE )INTEGER N, M, ITYPEREAL X(*), Y(*)INTEGER I, J, K, N1, N2, N4, IS, ID, I0, I1, I2, I3REAL TWOPI, E, A, A3, CC1, SS1, CC3, SS3REAL R1, R2, S1, S2, S3, XTINTRINSIC SIN, COSPARAMETER ( TWOPI = 6.2831853071795864769 ) cIF ( N .EQ. 1 ) RETURNcIF ( ITYPE .EQ. -1 ) THENDO 1, I = 1, NY(I) = - Y(I)1 CONTINUEENDIFcN2 = 2 * NDO 10, K = 1, M-1N2 = N2 / 2N4 = N2 / 4E = TWOPI / N2A = 0.0DO 20, J = 1, N4A3 = 3 * ACC1 = COS( A )SS1 = SIN( A )CC3 = COS( A3 )SS3 = SIN( A3 )A = J * EIS = JID = 2 * N240 DO 30, I0 = IS, N-1, IDI1 = I0 + N4I2 = I1 + N4I3 = I2 + N4R1 = X(I0) - X(I2)X(I0) = X(I0) + X(I2)R2 = X(I1) - X(I3)X(I1) = X(I1) + X(I3)S1 = Y(I0) - Y(I2)Y(I0) = Y(I0) + Y(I2)S2 = Y(I1) - Y(I3)Y(I1) = Y(I1) + Y(I3)S3 = R1 - S2R1 = R1 + S2S2 = R2 - S1R2 = R2 + S1X(I2) = R1 * CC1 - S2 * SS1Y(I2) = - S2 * CC1 - R1 * SS1X(I3) = S3 * CC3 + R2 * SS3Y(I3) = R2 * CC3 - S3 * SS330 CONTINUEIS = 2 * ID - N2 + JID = 4 * IDIF ( IS .LT. N ) GOTO 4020 CONTINUE10 CONTINUEcC--------LAST STAGE, LENGTH-2 BUTTERFLY ----------------------C cIS = 1ID = 450 DO 60, I0 = IS, N, IDI1 = I0 + 1R1 = X(I0)X(I0) = R1 + X(I1)X(I1) = R1 - X(I1)R1 = Y(I0)Y(I0) = R1 + Y(I1)Y(I1) = R1 - Y(I1)60 CONTINUEIS = 2 * ID - 1ID = 4 * IDIF ( IS .LT. N ) GOTO 50cC-------BIT REVERSE COUNTER-----------------------------------C c100 J = 1N1 = N - 1DO 104, I = 1, N1IF ( I .GE. J ) GOTO 101XT = X(J)X(J) = X(I)X(I) = XTXT = Y(J)Y(J) = Y(I)Y(I) = XT101 K = N / 2102 IF ( K .GE. J ) GOTO 103J = J - KK = K / 2GOTO 102103 J = J + K104 CONTINUEcIF ( ITYPE .EQ. -1 ) THENDO 2, I = 1, NX(I) = X(I) / NY(I) = - Y(I) / N2 CONTINUEENDIFcRETURNcc ... End of subroutine SFFTEU ...cEND!------------------------------------------------------------------。
Fortran函数大全(1)
Fortran函数大全(1)Fortran库参考SunStudio11SunMicrosystems,文件号码819-4757-102005年11月, 修订版A请将有关本文档的意见和建议提交至：/hwdocs/feedback版权所有#169;2005SunMicrosystems,Inc.,4150NetworkCircle,SantaCla ra,California95054,U.S.A.保留所有权利.美国政府权利－商业用途. 政府用户应遵循SunMicrosystems,Inc.的标准许可协议, 以及FAR （FederalAcquisitionRegulations, 即“联邦政府采购法规”）的适合条款及其补充条款. 必须依据许可证条款使用. 本发行版可能包含由第三方开辟的内容.本产品的某些部份可能是从BerkeleyBSD系统衍生出来的, 并获得了加利福尼亚大学的许可. UNIX是X/OpenCompany,Ltd.在美国和其他国家/地区独家许可的注册商标.Sun、SunMicrosystems、Sun徽标、Java和JavaHelp是SunMicrosystems,Inc.在美国和其他国家/地区的商标或者注册商标. 所有的SPARC商标的使用均已获得许可, 它们是SPARCInternational,Inc.在美国和其他国家/地区的商标或者注册商标. 标有SPARC商标的产品均基于由SunMicrosystems,Inc.开辟的体系结构.本服务手册所介绍的产品以及所包含的信息受美国出口控制法制约, 并应遵守其他国家/地区的进出口法律. 严禁将本产品直接或者间接地用于核设施、导弹、生化武器或者海上核设施, 也不能直接或者间接地出口给核设施、导弹、生化武器或者海上核设施的最终用户. 严禁出口或者转口到美国禁运的国家/地区以及美国禁止出口清单中所包含的实体, 包括但不限于被禁止的个人以及特殊指定的国家/地区的公民. 本文档按“原样”提供, 对于所有明示或者默示的条件、陈述和担保, 包括对适销性、适合性或者非侵权性的默示保证, 均不承担任何责任, 除非此免责声明的适合范围在法律上无效.目录阅读本书之前印刷约定xixiShell提示符支持的平台xiixiiixiii访问SunStudio软件和手册页访问编译器和工具文档访问相关的Solaris文档开辟者资源xviiixixxixxvixviii联系Sun技术支持Sun欢迎您提出意见1. Fortran库例程1.11.21.31–1数据类型注意事项64位环境1–21–1Fortran数学函数1.3.11.3.21.3.3单精度函数1–31–3双精度函数1–6四倍精度函数1–91–111–11iii1.4Fortran库例程参考1.4.1abort:终止和写入核心文件1.4.21.4.31.4.41.4.51.4.61.4.71.4.81.4.91.4.101.4.111.4. 121.4.131.4.141.4.151.4.161.4.171.4.181.4.191.4.201.4.21 1.4.221.4.231.4.241.4.251.4.261.4.271.4.281.4.29access:检查文件权限或者存在性1–11alarm:在指定的时间后调用子例程1–12bit:位函数：and、or、…、bit、setbit、…chdir：更改默认目录chmod:更改文件的模式1–131–161–171–18date：获取以字符串表示的当前日期dtime, etime：经过的执行时间exit：终止进程并设置状态1–201–231–23fdate：以ASCII字符串返回日期和时间flush：刷新逻辑单元的输出1–24fork：创建当前进程的副本1–25fseek,ftell：确定文件的位置以及重新确定文件的位置1–25fseeko64, ftello64：确定大文件的位置以及重新确定大文件的位置1–271–29getarg, iargc：获取命令行参数getc, fgetc：获取下一个字符1–301–32getcwd：获取当前工作目录的路径getenv：获取环境变量的值1–33getfd：获取外部单元编号的文件描述符getfilep：获取外部单元编号的文件指针getlog:获取用户的登录名getpid：获取进程ID1–341–341–361–361–36getuid, getgid：获取进程的用户ID或者组IDhostnm：获取当前主机的名称1–37idate：返回当前日期1–381–38ieee_flags, ieee_handler,sigfpe：IEEE算术index, rindex, lnblnk：子串的索引或者长度. 1–44inmax：返回最大正整数1–45itime：当前时间1–46ivFortran库参考2005年11月1.4.301.4.311.4.321.4.331.4.341.4.35kill：将信号发给进程1–471–47link, symlnk：链接到现有的文件loc：返回对象的地址1–491–491–50long, short：整型对象转换longjmp,isetjmp：返回至isetjmp设置的位置malloc, malloc64, realloc, free：分配/重新分配/释放内存1–521.4.36mvbits：挪移位字段1–561.4.37perror, gerror, ierrno：获取系统错误消息1–571.4.38putc, fputc：将字符写入逻辑单元1–581.4.39qsort, qsort64：对一维数组的元素进行排序1–601.4.40ran：生成一个介于0和1之间的随机数1–621.4.41rand, drand, irand：返回随机值1–631.4.42rename：重命名文件1–641.4.43secnds：获取以秒数表示的系统时间并减去参数1–651.4.44set_io_err_handler, get_io_err_handler：设置并获取I/O错误处理程序1–651.4.45sh：快速执行sh命令1–681.4.46signal：更改信号的操作1–691.4.47sleep：一段时间暂停执行1–701.4.48stat, lstat, fstat：获取文件状态1–701.4.49stat64, lstat64, fstat64：获取文件状态1–731.4.50system：执行系统命令1–731.4.51time, ctime, ltime, gmtime：获取系统时间1–741.4.52ttynam, isatty：获取终端端口的名称1–781.4.53unlink：删除文件1–791.4.54wait：等待进程终止1–802.Fortran95内部函数2–12.1标准Fortran95的通用内部函数2–1v目录2.1.12.1.22.1.32.1.42.1.52.1.62.1.72.1.82.1.92.1.102.1.1 12.1.122.1.132.1.142.1.152.1.162.1.172.1.182.1.192.1.202 .1.212.1.222.1.232.2参数存在查询函数数值函数数学函数字符函数。
Fortran实验代码
READ *, R
PRINT *,'R=',R,'C=',C(R)
PAUSE
END
FUNCTION C(R)
PI=3.1415926
C=2*PI*R
RETURN
END
****************************************************
PRINT * ,' 嘿嘿 '
PAUSE " 要记得向我一样，不断的提高自己 "
PRINT * ,' 不断的充实自己 '
PAUSE " 永远不要让自己停滞下来啊 "
PRINT * ,' 只有不断前行的人，才不会被时代遗忘 '
PAUSE " 才能跟上我的步伐 "
PRINT * ,' 相信宝贝能够明白我的 '
IF (MOD(YEAR,100).NE.0) THEN
PRINT *,YEAR,' 是闰年'
ELSE
IF (MOD(YEAR,400).EQ.0) THEN
PRINT *,YEAR,' 是闰年'
ELSE
PRINT *,YEAR,' 非闰年'
END
****************************************************
(6)随机数产生并检测质量
PROGRAM FILE
IMPLICIT REAL*8 (A-H,O-Z)