A fortran program (RELAX3D) to solve the 3 dimensional poisson (Laplace) equation
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。
Fortran语言编写弹性力学平面问题3节点三角形单元或4节点等参单元的有限元程序
Fortran语言编写弹性力学平面问题3节点三角形单元或4节点等参单元的有限元程序:c--------------------------------------------------------------------------c.....FEA2DP---A finite element analysis program for2D elastic problemscc Tangent matrix is stored with varioud band methodc This program is used to demonstrte the usage of vrious bandc Storage schem of symmetric and unsymmetric tangent matrixcc Wang shunjinc At chongqing vniversity(06/06/2013)c-------------------------------------------------------------------------program FEA2DPcc a(1)-a(n1-1):x(ndm,nummnp);a(n1)-a(n2-1):f(ndf,numnp)c a(n2)-a(n3-1):b(neq);a(n3)-a(n4-1):ad(neq)c a(n4)-a(n5-1):al(nad);a(n5)-a(n6-1):nu(nad)cc ia(1)-ia(n1-1):ix(nen1,numel);ia(n1)-ia(n2-1):id(ndf,numnp)c ia(n2)-ia(n3-1):jd((ndf*numnp);ia(n3)-ia(n4-1):idl(nen*numel*ndf)cimplicit real*8(a-h,o-z)dimension a(100000),ia(1000)character*80headcommon/cdata/numnp,numel,nummat,nen,neqcommon/sdata/ndf,ndm,nen1,nstcommon/iofile/ior,iowcnmaxm=100000imaxm=1000ior=1iow=2cc Open files for data input and outputcopen(ior,file='input.dat',form='formatted')open(iow,file='output.dat')cc.....Read titlecread(ior,'(a)')headwrite(iow,'(a)')headcc.....Read and print control informationcc numnp:number of nodesc numel:number of elementsc nummat:number of material typesc nload:number of loadsc ndm:number of coordinats of each nodec ndf:number of degrees of freedomc nen:number of nodes in each elementcread(ior,'(7i5)')numnp,numel,nummat,nload,ndm,ndf,nenwrite(iow,2000)numnp,numel,nummat,nload,ndm,ndf,nen cc.....Set poiters for allocation of data arrayscnen1=nen+4nst=nen*ndfnneq=ndf*numnpcn1=ndm*numnp+1n2=n1+ndf*numnp+1ci1=nen1*numel+1i2=i1+ndf*numnp+1i3=i2+ndf*numnp+1i4=i3+numel*nen*ndf+1cc.....Call mesh input subroutine to read all mesh dataccall pmesh(a(1),a(n1),ia(1),ia(i1),ndf,ndm,nen1,nload)cpute profileccall profil(ia(i2),ia(i3),ia(i1),ia(1),ndf,nen1,nad)cn3=n2+neq+1n4=n3+neq+1n5=n4+nad+1n6=n5+nad+1cc The lengthes of real and integer arrayscwrite(iow,2222)n6,i4cc The lengthes of array exceeds the limitationcif(n6>nmaxm.or.i4>imaxm)thenif(n6>nmaxm)write(iow,3333)n6,nmaxmif(i4>nmaxm)write(iow,4444)i4,imaxmstopend ifctute and aseemble element arraysccall assem(nad,ia(1),ia(i1),ia(i2),a(1),a(n2),a(n3),1a(n4),a(n5))cc Form load vectorccall pload(ia(i1),a(n1),a(n2),nneq,neq)cc.....Triangular decomposition of a matrix stored in profile formccall datri(ndf,numnp,ia(i2),neq,nad,.false.,a(n3),a(n5),a(n5))cc For unsymmtric tangent matirxc Call datri(ndf,numnp,ia(i2),neq,nad,.true.,a(n3),a(n4),a(n5))cc Solve equationsccall dasol(ndf,numnp,a(n2),ia(i2),neq,nad,aengy,a(n3),a(n5),a(n5)) cc For unsymmetric tangent matrixc Call dasol(ndf,numnp,a(n2),ia(i2),neq,nad,aengy,a(n3),a(n5),a(n5)) cc Output nodal displacementsccall prtdis(ia(i1),a(n2),ndf,numnp,neq)cc.....Close input and output files;destroy temporary disk filescclose(ior)close(iow)cc.....Input/output formatsc1000format(20a4)2000format(//x5x,'number of nodal points=',i6/15x,'number of elements=',i6/25x,'number of material sets=',i6/35x,'number of nodal loads=',i6/45x,'dimension of coordinate space=',i6/55x,'degree of freedoms/node=',i6/65x,'nodes per element(maximum)=',i6)2222format(//,10x,'the lengthe of real array is',i10,/,110x,'the lengthe of integer array is',i10)3333format(//,10x,'the lengthe of real array',i10,'exceed the',1'maximun value',i10)4444format(//,10x,'the lengthe of integer array',i10,'exceed the',1'maximun value',i10)cstopendccsubroutine pmesh(x,f,ix,id,ndf,ndm,nen1,nload)cc......Data input routine for mesh descriprioncimplicit real*8(a-h,o-z)dimension x(ndm,numnp),f(ndf,numnp),id(ndf,numnp),ix(nen1,numel)common/bdata/head(20)common/cdata/numnp,numel,nummat,nen,neqcommon/mater/ee,xnu,itypecommon/iofile/ior,iowcc.....Input constrain codes and nodal coordinate datacc id(k,j):constrain code of kth degree of freedom of node j,=0:free,=1:fixed c x(k,j):kth coordinate of node jcdo i=1,numnpread(ior,'(3i5,2f10.4)')j,(id(k,j),k=1,ndm),(x(k,j),k=1,ndm) end docwrite(iow,'(//17hnodal coordinates,/)')do i=1,numnpwrite(iow,'(3i5,2f10.4)')i,(id(k,i),k=1,ndm),(x(k,i),k=1,ndm) end docc.....element data inputcc ix(k,j):global node number of kth node in element jcdo i=1,numelread(ior,'(9i5)')j,(ix(k,j),k=1,nen)end docwrite(iow,'(//,18helement definition,/)')do i=1,numelwrite(iow,'(9i5)')j,(ix(k,j),k=1,nen)end docc.....Material data inputcc ee:young's modulus,xnu:poisson ratioc itype:type of problem,=1,:plane stress,=2:plane strain,=3:axi-symmetric cread(ior,'(2f10.4,i5)')ee,xnu,itypewrite(iow,'(//,19hmateial properties,/)')write(iow,'(2(e10.4,5x),i5)')ee,xnu,itypecc.....force/disp data inputcc f(k,j):concentrate load at node j in k directioncf=0.0d0do i=1,nloadread(ior,'(i5,2f10.4)')j,(f(k,j),k=1,ndf)end docwrite(iow,'(//,20happlied nodal forces,/)')do i=1,nloadwrite(iow,'(i5,2f10.4)')j,(f(k,j),k=1,ndf)end docreturncc format statementsc2000format('mesh1>',$)3000format(1x,'**warning**element connections necessary'1'to use block in macro program')4000format('**current problem valies**'/i6,'nodes,',1i5,'elmts,',i3,'matls,',i2,'dims,',i2,'dof/node,',2i3,'nodes/elmt')endccsubroutine assem(nad,ix,id,jd,x,b,ad,al,au)cc Call element subroutine and assemble global tangent matrixcimplicit real*8(a-h,o-z)dimension ilx(nen),xl(ndf,nen),ld(ndf,nen),s(nst,nst),p(nst)dimension ix(nen1,numel),id(ndf,numnp),jd(ndf*numnp)dimension x(ndm,numnp),b(neq),ad(neq),al(nad),au(nad)common/cdata/numnp,numel,nummat,nen,neqcommon/sdata/ndf,ndm,nen1,nstcnel=nencc elenment loopcdo320n=1,numels=0.0d0!element stiffness matrixp=0.0d0!nodal forcene=ndo310i=1,nenilx(i)=ix(i,ne)!current element definitiondo k=1,ndmxl(k,i)=x(k,ilx(i))!nodal coords in current elementend dokk=ilx(i)do k=1,ndfld(k,i)=id(k,kk)!equation numbersend do310continuecc Call element libccall elmt01(xl,ilx,s,p,ndf,ndm,nst)cc Asemmble tangent matrix and load vector if neededccall dasbly(ndf,nad,s,p,ld,jd,nst,b,ad,al,au)c320continue!end element loopcreturnendccsubroutine dasbly(ndf,nad,s,p,ld,jp,ns,b,ad,al,au)cc.....Assemble the symmetric or unsymmetric arrays for'dasol'cimplicit real*8(a-h,o-z)c logical alfl,aufl,bfldimension ad(neq),al(nad),au(nad)dimension ld(ns),jp(ndf*numnp),b(neq),s(ns,ns),p(ns)common/cdata/numnp,numel,nummat,nen,neqcommon/iofile/ior,iowcc alfl=true:for unsymmetric matirx assemblec alfl=false:for symmetric matirx assemblec s:element stiffness matrixc p:load or internal force vectorc ad:diagonal elementsc au:upper triangle elementsc al:lower triangle elementsc jp:pointer to last element in each row/column of al/au respectivec ld:equation numbers of each freedom degree in an element(get from id) cc.....Loop through the rows to perform the assemblycdo200i=1,nsii=ld(i)if(ii.gt.0)thenc if(aufl)then!assemble stiffness matrixcc.....Loop through the columns to perform the assemblycdo100j=1,nsif(ld(j).eq.ii)thenad(ii)=ad(ii)+s(i,j)elseif(ld(j).gt.ii)thenjc=ld(j)jj=ii+jp(jc)-jc+1au(jj)=au(jj)+s(i,j)c if(alfl)al(jj)=al(jj)+s(j,i)!unsymmetricendif100continueendifc if(bfl)b(ii)=b(ii)+p(i)!assemble nodal forcec endif200continuecreturnendccsubroutine dasol(ndf,numnp,b,jp,neq,nad,energy,ad,al,au)cc.....Solution of symmetric equations in profile formc.....Coeficient matrix must be decomposed into its triangularc.....Factor using datri beforce using dasol.cc jp:pointer to last element in each row/column of al/au respecive ccimplicit real*8(a-h,o-z)dimension ad(neq),al(nad),au(nad)dimension b(neq),jp(ndf*numnp)common/iofile/ior,iowdata zero/0.0d0/cc.....Find the first nonzero entry in the ring hand sidecdo is=1,neqif(b(is).ne.zero)go to200end dowrite(iow,2000)returnc200if(is.lt.neq)thencc.....Reduce the right hand sidecdo300j=is+1,neqjr=jp(j-1)jh=jp(j)-jrif(jh.gt.0)thenb(j)=b(j)-dot(al(jr+1),b(j-jh),jh)end if300continueend ifcc.....Multiply inverse of diagonal elementscenergy=zerodo400j=is,neqbd=b(j)b(j)=b(j)*ad(j)energy=energy+bd*b(j)400continuecc.....backsubstitutioncif(neq.gt.1)thendo500j=neq,2,-1jr=jp(j-1)jh=jp(j)-jrif(jh.gt.0)thencall saxpb(au(jr+1),b(j-jh),-b(j),jh,b(j-jh))end if500continueend ifcreturnc2000format('**dasol warning1**zero right-hand-side vector') endccsubroutine datest(au,jh,daval)cc.....test for rankcimplicit real*8(a-h,o-z)dimension au(jh)cdaval=0.0d0cdo j=1,jhdaval=daval+abs(au(j))end docreturnendccsubroutine datri(ndf,numnp,jp,neq,nad,flg,ad,al,au)cc.....Triangular decomposiontion of a matrix stored in profile form cimplicit real*8(a-h,o-z)logical flgdimension jp(ndf*numnp),ad(neq),al(nad),au(nad)common/iofile/ior,iowcc.....n.b.tol should be set to approximate half-word precision.cdata zero,one/0.0d0,1.0d0/,tol/0.5d-07/cc.....Set initial values for contditioning checkcdimx=zerodimn=zerocdo j=1,neqdimn=max(dimn,abs(ad(j)))end dodfig=zerocc.....Loop through the columns to perform the triangular decomposition cjd=1do200j=1,neqjr=jd+1jd=jp(j)jh=jd-jrif(jh.gt.0)thenis=j-jhie=j-1cc.....If diagonal is zeor compute a norm for singularity testcif(ad(j).eq.zero)call datest(au(jr),jh,daval)do100i=is,iejr=jr+1id=jp(i)ih=min(id-jp(i-1),i-is+1)if(ih.gt.0)thenjrh=jr-ihidh=id-ih+1au(jr)=au(jr)-dot(au(jrh),al(idh),ih)if(flg)al(jr)=al(jr)-dot(al(jrh),au(idh),ih)end if100continueend ifcc.....Reduce the diagonalcif(jh.ge.0)thendd=ad(j)jr=jd-jhjrh=j-jh-1call dredu(al(jr),au(jr),ad(jrh),jh+1,flg,ad(j))cc.....Check for possible errors and print warningscif(abs(ad(j)).lt.tol*abs(dd))write(iow,2000)jif(dd.lt.zero.and.ad(j).gt.zero)write(iow,2001)jif(dd.gt.zero.and.ad(j).lt.zero)write(iow,2001)jif(ad(j).eq.zero)write(iow,2002)jif(dd.eq.zero.and.jh.gt.0)thenif(abs(ad(j)).lt.tol*daval)write(iow,2003)jendifendifcc.....Stroe reciprocal of diagonal,compute condition checkscif(ad(j).ne.zero)thendimx=max(dimx,abs(ad(j)))dimn=min(dimn,abs(ad(j)))dfig=max(dfig,abs(dd/ad(j)))ad(j)=one/ad(j)end if200continuecc.....Print conditioning informationcdd=zeroif(dimn.ne.zero)dd=dimx/dimnifig=dlog10(dfig)+0.6write(iow,2004)dimx,dimn,dd,ifigcreturncc.....formatsc2000format('**datri warning1**loss of at least7digits in', 1'reducing diagonal of equation',i5)2001format('**datri warning2**sign of changed when', 1'reducing equation',i5)2002format('**datri warning3**reduced diagonal is zero zeri for', 1'equation',i5)2003format('**datri warning4**rank failure ffo zero unreduced', 1'diagonal in equation',i5)2004format(//'conditon check:d-max',e11.4,';d-min',e11.4, 1';ratio',e11.4/'maximim no.diagonal digits lost:',i3) 2005format('cond ck:dmax',1p1e9.2,';dmin',1p1e9.2,1';ratio',1p1e9.2)endccsubroutine dredu(al,au,ad,jh,flg,dj)cc.....Reduce diagonal element in triangular decompositioncimplicit real*8(a-h,o-z)logical flgdimension al(jh),au(jh),ad(jh)cdo j=1,jhud=au(j)*ad(j)dj=dj-al(j)*udau(j)=udend docc.....Finish computation of column of al for unsymmetric matricescif(flg)thendo j=1,jhal(j)=al(j)*ad(j)end doend ifcreturnendccsubroutine profil(jd,idl,id,ix,ndf,nen1,nad)cpute profile of global arrayscimplicit real*8(a-h,o-z)dimension jd(ndf*numnp),idl(numel*nen*ndf),id(ndf,numnp),1ix(nen1,numel)common/cdata/numnp,numel,nummat,nen,neqcommon/frdata/maxfcommon/iofile/ior,iowcc jd:column hight(address of diagonal elements)c id:boudary condition codes before this bubroutine's runningc id:equation numbers in global array(excluded restrained nodes)after running c idl:element strech orderc nad:total number of non-zero elements except diagonal elementsc in global tangent matrixcc.....Set up the equation numberscneq=0cdo10k=1,numnpdo10n=1,ndfj=id(n,k)if(j.eq.0)thenneq=neq+1id(n,k)=neqelseid(n,k)=0endif10continuecpute column heightsccall pconsi(jd,neq,0)cdo50n=1,numelmm=0nad=0do30i=1,nenii=iabs(ix(i,n))if(ii.gt.0)thendo20j=1,ndfjj=id(j,ii)if(jj.gt.0)thenif(mm.eq.0)mm=jjmm=min(mm,jj)nad=nad+1idl(nad)=jjendif20continueend if30continueif(nad.gt.0)thendo40i=1,nadii=idl(i)jj=jd(ii)jd(ii)=max(jj,ii-mm)40continueendif50continuecpute diagongal pointers for profilecnad=0jd(1)=0if(neq.gt.1)thendo60n=2,neqjd(n)=jd(n)+jd(n-1)60continuenad=jd(neq)end ifcc.....Set element search order to sequentialcdo70n=1,numelidl(n)=n70continuecc.....equation summarycmaxf=0mm=0if(neq.gt.0)mm=(nad+neq)/neqwrite(iow,2001)neq,numnp,mm,numel,nad,nummatcreturnc2001format(5x,'neq=',i5,5x,'numnp=',i5,5x,'mm=',i5,/5x, 1'numel=',i5,5x,'nad=',i5,5x,'nummat=',i5/) endcsubroutine saxpb(a,b,x,n,c)cc.....Vector times scalar added to second vectorcimplicit real*8(a-h,o-z)dimension a(n),b(n),c(n)cdo k=1,nc(k)=a(k)*x+b(k)end docreturnendcsubroutine pconsi(iv,nn,ic)cc.....Zero integer arraycdimension iv(nn)cdo n=1,nniv(n)=icend docreturnendcsubroutine elmt01(xl,ilx,s,p,ndf,ndm,nst)cc.....plane linear elastic element routinec ityp=1:plane stressc=2:plane strainc=3:axisymmetriccimplicit real*8(a-h,o-z)dimension xl(ndm,nen),ilx(nen),sigr(6)dimension d(18),s(nst,nst),p(nst),shp(3,9),sg(16),tg(16),wg(16)character wd(3)*12common/cdata/numnp,numel,nummat,nen,neqcommon/mater/ee,xnu,itypecommon/iofile/ior,iowdata wd/'plane stress','plane strain','axisymmetric'/cc xl(ndm,nen):coords of each node in current elementc ilx(nen):element definition of current elementc d(18):materials propertiesc s(nst,nst):element stiffness matrixc p(ns):nodal force and internal forcec shp(3,9):shape function and its derivativesc sg(16),tg(16),wg(16):weight coefficients of guass intergtation c l,k:integration pointscl=2k=2e=eenel=nencc d(14):thickness;d(11),d(12):body forcesc.....Set material patameter type and flagscityp=max(1,min(ityp,3))j=min(ityp,2)cd(1)=e*(1.+(1-j)*xnu)/(1.+xnu)/(1.-j*xnu)d(2)=xnu*d(1)/(1.+(1-j)*xnu)d(3)=e/2./(1.+xnu)d(13)=d(2)*(j-1)if((d(14).le.0.0d0).or.ityp.ge.2)d(14)=1.0d(15)=itypd(16)=ed(17)=xnud(18)=-xnu/el=min(4,max(1,l))k=min(4,max(1,k))d(5)=ld(6)=kc d(9)=t0c d(10)=e*alp/(1.-j*xnu)lint=0cwrite(iow,2000)wd(ityp),d(16),d(17),d(4),l,k,d(14),1d(11),d(12)cc.....stiffness/residual computationcl=kcc Compute cordinates and weights of integtation pointc`sg,tg:cootds;wg=wp*wqcif(l*l.ne.lint)call pguass(l,lint,sg,tg,wg)cpute integrals of shape functionscdo340l=1,lintcc Compute shape function and their derivatives to local and global coordinate systemccall shape(sg(l),tg(l),xl,shp,xsj,ndm,nen,ilx,.false.)cc Compute global coordinates of integration pointscxx=0.0yy=0.0do j=1,nenxx=xx+shp(3,j)*xl(1,j)yy=yy+shp(3,j)*xl(2,j)end doxsj=xsj*wg(l)*d(14)!xsj+|j|(sp,tq)*wp*wq*tcpute jacobian correction for plane stress and strain problemscif(ityp.le.2)thendv=xsjxsj=0.0zz=0.0c sigr4=-d(11)*dv!d(11)body forceelsecc For anisymmetric problemcdv=xsj*xx*3.1415926*2.zz=1./xxc sigr4=sigr(4)*xsj-d(11)*dvendifj1=1cc.....Loop over rowscdo330j=1,nelw11=shp(1,j)*dvw12=shp(2,j)*dvw22=shp(3,j)*xsjw22=shp(3,j)*dv*zzccpute the internal forces out of balancecc p(j1)=p(j1)-(shp(1,j)*sigr(1)+shp(2,j)*sigr(2))*dvc1-shp(3,j)*sigr4c p(j1+1)=p(j1+1)-(shp(1,j)*sigr(2)+shp(2,j)*sigr(3))*dvc1+d(12)*shp(3,j)*dv!d(12)body force cc.....Loop over columns(symmetry noted)c Compute stiffness matrixck1=j1a11=d(1)*w11+d(2)*w22a21=d(2)*w11+d(1)*w22a31=d(2)*(w11+w22)a41=d(3)*w12a12=d(2)*w12a32=d(1)*w12a42=d(3)*w11do320k=j,nelw11=shp(1,k)w12=shp(2,k)w22=shp(3,k)*zzs(j1,k1)=s(j1,k1)+w11*a11+w22*a21+w12*a41s(j1+1,k1)=s(j1+1,k1)+(w11+w22)*a12+w12*a42s(j1,k1+1)=s(j1,k1+1)+w12*a31+w11*a41s(j1+1,k1+1)=s(j1+1,k1+1)+w12*a32+w11*a42k1=k1+ndf320continuej1=ndf+j1330continue340continuecc.....Make stiffness symmetriccdo360j=1,nstdo360k=j,nsts(k,j)=s(j,k)360continuecreturncc.....Formats for input-outputc1000format(3f10.0,3i10)1001format(8f10.0)2000format(/5x,a12,'linear elastic element'//110x,'modulus',e18.5/10x,'poission ratio',f8.5/10x,'density',e18.5/ 210x,'guass ptr/dir',i3/10x,'stress pts',i6/10x,'thickness',e16.5/310x,'1-gravity',e16.5/10x,'2-gtavity',e16.5/10x,'alpha',e20.5/410x,'base temp',e16.5/)2001format(5x,'element stresses'//'elmt1-coord',2x,'11-stress',2x, 1'12-stress',2x,'22-stress',2x,'33-stress',3x,'1-coord',2x,3x,2'2-stress'/'matl2-coord',2x,'11-strain',2x,'12-strain'2x,3'22-strain',2x,'33-strain',6x,'angle'/39('-'))2002format(i4,0p1f9.3,1p6e11.3/i4,0p1f9.3,1p4e11.3,0p1f11.2/) 5000format('input:e,nu,rho,pts/stiff,pts/stre',1',type(1=stress,2=strain,3=axism)',/3x,'>',$)5001format('input:thickness,1-body force,1-body force,alpha,' 1,'temp-base'/3x,'>',$)endcsubroutine shape(ss,tt,xl,shp,xsj,ndm,nel,ilx,flg)cc.....Shape function routine for two dimension elementscimplicit real*8(a-h,o-z)logical flgdimension xl(ndm,nel),s(4),t(4),x(nel)dimension shp(3,nel),xs(2,2),sx(2,2)data s/-0.5d0,0.5d0,0.5d0,-0.5d0/,1t/-0.5d0,-0.5d0,0.5d0,0.5d0/cc.....Form4-node quatrilateral shape functionscc nel:nuber of nodes per elementcdo100i=1,4shp(3,i)=(0.5+s(i)*ss)*(0.5+t(i)*tt)shp(1,i)=s(i)*(0.5+t(i)*tt)shp(2,i)=t(i)*(0.5+s(i)*ss)100continuecc.....Form triangge bu adding their and fourth together for triangle element cif(nel.eq.3)thendo i=1,3shp(i,3)=shp(i,3)+shp(i,4)enddoendifcc.....Add quatratic terms if necessary for element with more than4nodes cif(nel.gt.4)call shap2(ss,tt,shp,ilx,nel)cc.....Construct jacobian and its inversecdo125i=1,2do125j=1,2xs(i,j)=0.0do120k=1,nelxs(i,j)=xs(i,j)+xl(i,k)*shp(j,k)120continue125continuecc xsj:determinate of jacob matrixcxsj=xs(1,1)*xs(2,2)-xs(1,2)*xs(2,1)cif(flg)returnc flg=false:form global derivativescif(xsj.le.0.0d0)xsj=1.0sx(1,1)=xs(2,2)/xsjsx(2,2)=xs(1,1)/xsjsx(1,2)=-xs(1,2)/xsjsx(2,1)=-xs(2,1)/xsjcc....Form global derivativescdo130i=1,neltp=shp(1,i)*sx(1,1)+shp(2,i)*sx(2,1)shp(2,i)=shp(1,i)*sx(1,2)+shp(2,i)*sx(2,2)shp(1,i)=tp130continuecreturnendcsubroutine shap2(s,t,shp,ilx,nel)cc....Add quadtatic function as necessarycimplicit real*8(a-h,o-z)dimension shp(3,9),ilx(nel)cs2=(1.-s*s)/2.t2=(1.-t*t)/2.do100i=5,9do100j=1,3shp(j,i)=0.0100continuecc.....Midsize nodes(serenipity)cif(ilx(5).eq.0)go to101shp(1,5)=-s*(1.-t)shp(2,5)=-s2shp(3,5)=s2*(1.-t)101if(nel.lt.6)go to107if(ilx(6).eq.0)go to102shp(1,6)=t2shp(2,6)=-t*(1.+s)shp(3,6)=t2*(1.+s)102if(nel.lt.7)go to107if(ilx(7).eq.0)go to103shp(1,7)=-s*(1.+t)shp(2,7)=s2shp(3,7)=s2*(1.+t)103if(nel.lt.8)go to107if(ilx(8).eq.0)go to104shp(1,8)=-t2shp(2,8)=-t*(1.-s)shp(3,8)=t2*(1.-s)cc.....Interior node(lagragian)c104if(nel.lt.9)go to107if(ilx(9).eq.0)go to107shp(1,9)=-4.*s*t2shp(2,9)=-4.*t*s2shp(3,9)=4.*s2*t2cc.....Correct edge nodes for interior node(lagrangian) cdo106j=1,3do105i=1,4105shp(j,i)=shp(j,i)-0.25*shp(j,9)do106i=5,8106if(ilx(i).ne.0)shp(j,i)=shp(j,i)-.5*shp(j,9)cc.....Correct corner nodes for presense of midsize nodes c107do108i=1,4k=mod(i+2,4)+5l=i+4do108j=1,3108shp(j,i)=shp(j,i)-0.5*(shp(j,k)+shp(j,l))returnendcsubroutine pguass(l,lint,r,z,w)cc.....Guass points and weights for two dimensionscimplicit real*8(a-h,o-z)dimension lr(9),lz(9),lw(9),r(16),z(16),w(16)c common/eldtat/dm,n,ma,mct,iel,neldata lr/-1,1,1,-1,0,1,0,-1,0/,lz/-1,-1,1,1,-1,0,1,0,0/data lw/4*25,4*40,64/cc lint:number of integration pointsc r,z:coordinates of integration pointsc w:wp*wq,product of the two weightsclint=l*lcc.....1x1integerationc1r(1)=0.z(1)=0.w(1)=4.creturncc.....2x2integerationc2g=1.0/sqrt(3.d0)do i=1,4r(i)=g*lr(i)z(i)=g*lz(i)w(i)=1.end docreturncc.....3x3integerationc3g=sqrt(0.60d0)h=1.0/81.0d0cdo i=1,9r(i)=g*lr(i)z(i)=g*lz(i)w(i)=h*lw(i)enddocreturncendcsubroutine pload(id,f,b,nneq,neq) cc.....Form load vector in compact formcimplicit real*8(a-h,o-z)dimension f(nneq),b(neq),id(nneq)common/iofile/ior,iowcb=0.0d0cj=id(n)if(j.gt.0)thenb(j)=f(n)endifenddocreturnendcsubroutine prtdis(id,b,ndf,numnp,neq)cc Print out nodal displacementscimplicit real*8(a-h,o-z)dimension id(ndf,numnp),b(neq),u(ndf,numnp)common/iofile/ior,iowcu=0.0d0do100i=1,numnpdo j=1,ndfn=id(j,i)if(n>0)u(j,i)=b(n)end do100continuecc Out nodal displacementscwrite(iow,'(//,19hnodal displacements,/)')do i=1,numnpwrite(iow,'(5x,i5,2x,3(e12.4,3x))')i,(u(k,i),k=1,ndf) end docreturnendcdouble precision function dot(a,b,n)implicit real*8(a-h,o-z)dimension a(n),b(n)cc.....Dot product functioncdot=0.0d0do10k=1,ndot=dot+a(k)*b(k)10continuereturn end。
FORTRAN常见错误
FORTRAN常见错误41 Insufficient virtual memory 虚拟内存不足70 Integer overflow 整数溢出错误71 Integer divide by zero 整数除0错误72 Floating overflow 浮点数溢出错误73 Floating divide by zero 浮点数除0错误74 Floating underflow 浮点数下溢错误75 Floating point exception 浮点数异常错误77 Subscript out of range 数组定义超出边界95 Floating-point conversion failed 浮点数格式转换失败146 Null pointer error 空指针错误147 Stack overflow 堆栈溢出148 String length error 字符串长度超出允许范围149 Substring error 数组下标超出允许范围150 Range error 整数值超出允许范围151 Allocatable array is already allocated 数组重复定义161 Program Exception - array bounds exceeded 引用数组下标超出允许范围162 Program Exception - denormal floating-point operand 非法浮点数操作符163 Program Exception - floating stack check 浮点数堆栈检查164 Program Exception - integer divide by zero 整数除0错误165 Program Exception - integer overflow 整数溢出166 Program Exception - privileged instruction 非法执行特权指令168 Program Exception - illegal instruction 非法指令170 Program Exception - stack overflow 堆栈溢出540 Array or substring subscript expression out of range 数组下标低下数组定义下界或高于数组定义上界541 CHARACTER substring expression out of range 字符串非法表示542 Label not found in assigned GOTO list 不属于GOTO语句引用的标号543 INTEGER arithmetic overflow 整数运算结果出现溢出544 INTEGER overflow on input 输入的整数值超出允许范围545 Invalid INTEGER 非法整数值546 REAL indefinite (uninitialized or previous error) 产生非法实数547 Invalid REAL 非法实数548 REAL math overflow 实数值溢出549 No matching CASE found for SELECT CASE select case语句中缺少case项550 INTEGER assignment overflow 整数定义超出允许范围556 A edit descriptor expected for CHARACTER 字符型数据的格式化输入和输出需要A编辑符557 E, F, D, or G edit descriptor expected for REAL 实数型数据的格式化输入和输出需要E,F,D,G编辑符558 I edi t descriptor expected for INTEGER 整数型数据的格式化输入和输出需要I编辑符559 L edit descriptor expected for LOGICAL 逻辑型数据的格式化输入和输出需要L编辑符568 Multiple radix specifiers 输入或输出语句重复说明582 Array already allocated 数组已分配583 Array size zero or negative 数组大小为0或负数585 Array not allocated 没有被分配的数组610 Invalid argument 非法参数616 Invalid number in input 输入非法数字617 Invalid string in input 输入非法字符串618 Comma missing in COMPLEX input 输入的多个表达式之间缺少逗号619 T or F expected in LOGICAL read 输入的逻辑值必须是T或F622 Illegal character in hexadecimal input 输入非法的十六进制数637 Integer expected in format 格式语句中要求的整数638 Initial left parenthesis expected in format 格式语句中多余的左括号639 Positive integer expected in format 格式语句中要求用正整数641 Integer expected preceding H, X, or P edi t descriptor 在H、X、P编辑符前要求用整数644 '.' expected in format 在D、E、F、G编辑符中w和d域之间用'.'分隔645 Unexpected end of format 格式语句没有结束646 Unexpected character in format 格式语句中的非法字符647 M field exceeds W field in I edit descriptor 在I编辑符中M域的值大于W域的值648 Integer out of range in format 格式语句中的整数值超出允许范围650 Separator expected in format 格式语句中需要分隔符663 Out of range: substring starting position 'pos' is less than 1 子字符串的起始位置小于1664 Out of range: substring ending position 'pos' is greater than string length 'len' 子字符串的终止位置大于字符串长度672 Out of memory 内存不足718 Cannot allocate temporary array -- out of memory 由于内存不足不能分配临时数组727 Cannot ALLOCATE allocatable array -- out of memory 由于内存不足不能分配数组729 DEALLOCATE failure: ALLOCATABLE array is not ALLOCATED 释放没有被分配的数组。
fortran课后习题第五章
第五章第一题program wd51implicit nonereal :: areal :: bwrite(*,*) "请输入一位上班族的月收入a="read(*,*) aif (a<=1000) thenb=a*0.03else if(a>=1000 .and. a<=5000) thenb=a*0.1elseb=a*0.15end ifwrite(*,*)"这位上班族所应缴纳的税金b=",bstopend第二题program wd52implicit noneinteger :: weekwrite(*,*)"请输入星期来查询当天晚上的节目week=" read(*,*) weekif(week==1 .or. week==4) thenwrite(*,*) "新闻"else if(week==2 .or. week==5) thenwrite(*,*) "电视剧"else if(week==3 .or. week==6) thenwrite(*,*) "卡通片"elsewrite(*,*) "电影"end ifend第三题program wd53implicit noneinteger age,moneyreal taxwrite(*,*) "请输入一位上班族的年龄="read (*,*) agewrite(*,*) "输入他的年收入="read (*,*) moneyif (age<50) thenif(money<=1000) thentax=money*0.03else if(money>1000 .and. money<5000) thentax=money*0.1elsetax=money*0.15end ifelse if (age>=50) thenif(money<=1000) thentax=money*0.05else if(money>1000 .and. money<5000) thentax=money*0.07elsetax=money*0.1end ifend ifwrite(*,*) "这位上班族所缴纳的税金是=",tax stopend第四题program wd54implicit noneinteger year,daylogical :: a,b,cwrite(*,*) "请输入一个公元年份="read (*,*) yeara=(MOD(year,4)==0)b=(MOD(year,100)==0)c=(MOD(year,400)==0)if((a.NEQV.b) .or. c) thenday=366elseday=365end ifwrite(*,*)"一年当中有",day,"天" stopend。
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选择题参考
Fortran选择题参考Fortran90选择题错误难免,仅供参考。
1、下列叙述中,正确的是(D)原因:略。
A,语句标号的大小影响程序执行的顺序B,程序完全按语句出现的先后顺序执行C,不同程序单位不能有相同的语句标号D,同一程序单位不能有相同的语句标号2、下列标识符中,不能作为合法的fortran90标识符的是(C)原因:标识符开头只能是字母。
A,A3_B3 B,VOID C,_123 D,IF3、下列哪一个为正确的常量(D)原因:A不能用“,”分隔。
B属于表达式。
C.TRUE.才是逻辑常量。
D字符常量。
A,123,000 B,3.5E+2.5 C,TRUE D,”HELLO”4、若A=2,B=2,I=3,则表达式A**B**I的值为(C)原因:乘方运算从右到左,相当于A**(B**I)。
A,64 B,12 C,256 D,165、圆的直径存放在整型变量D之中,下列计算圆面积的表达式中正确的是(D)原因:“/”是取整运算符,所以排除A、B、C。
详细参考书本21页。
A,3.14159*(D/2)*(D/2)B, 3.14159*(D*D/4)C, 3.14159*(D/2)**2D, 3.14159*D*D/46、下列运算符中,运算优先级最高的是(B)原因:优先级:算术运算>关系运算>逻辑运算(.NOT.>.AND.>.OR.)。
A,关系运算 B,算术运算 C,逻辑非运算 D,逻辑与运算7、下列fortran的表达式中值为0.5的是(C)原因:A值为0.3 B值为0 C值为0.5 D值为0A,MOD(4.8,0.5) B,100/20/10 C,50.0/4/25 D,MOD(15,10)/108、下列是完整的fortran程序,编译时出错的语句是(C)原因:PARAMETER定义的常量不能被修改。
A,PROGRAM PRINTB,PARAMETER(PI=3.1415926)C,PI=PI+1D,WRITE(*,*)SIN(PI+0.5)END9、变量的类型定义中,优先级由高到低的顺序为(A)原因:优先级:类型说明语句>IMPLICIT说明语句>隐含约定。
西安交通大学工程分析程序设计Fortran上机作业参考答案
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . .
. . . . . . . .
. . . . .
1
8 指 针 、格 式化 输入 /输 出、 文件 操作 8.1 格式化输入输出 . . . . . . . . . 8.1.1 整数 . . . . . . . . . . . 8.1.2 实数 . . . . . . . . . . . 8.1.3 复数 . . . . . . . . . . . 8.1.4 逻辑型 . . . . . . . . . . 8.1.5 字符串 . . . . . . . . . . 8.2 输出金字塔形状 . . . . . . . . . 8.3 整齐的杨辉三角形 . . . . . . . 8.4 龙格-库塔法求解微分方程 . . . 8.5 Shell排序 . . . . . . . . . . . . 9 参考文献 10 LICENSE
fortran常见错误及其原因
常见fortran错误1. Incrementally linked image--PC correlation disabled.!编译终止2. forrtl: severe (157): Program Exception - access violation!The program tried to read from or write to a virtual address for which it does not have the appropriate access. Try recompiling with the /check:bounds and /warn:argument_checking options set, to see if the problem is an out-of-bounds memory reference or a argument mismatch that causes data to be treated as an address.Other causes of this error include:Mismatches in C vs. STDCALL calling mechanisms, causing the stack to become corrupted References to unallocated pointers Attempting to access a protected (for example, read-only) address3 "forrtl: severe (64): input conversion error, unit 2, file D:\FORTRAN2\testi!文件testi正在读写,直到读写到2时错误。
举例:程序想读写整数,却碰到变量故终止。
4 error LNKZOOI : unresolved external symbol _ SN @ 4 fatal error LNKllZO : 1 unresolved externals! 出现了未指定的外部函数符号Sn 。
fortran课后习题答案
第一章 FORTRAN程序设计基础第15页 1、21.简述程序设计的步骤。
“程序设计”:反映了利用计算机解决问题的全过程,通常要经过以下四个基本步骤:(1)分析问题,确定数学模型或方法;(2)设计算法,画出流程图;(3)选择编程工具,编写程序;(4)调试程序,分析输出结果。
2. 什么是算法?它有何特征?如何描述算法?解决问题的方法和步骤称为算法。
算法的五个特征:(1) 有穷性。
(2) 确定性。
(3) 有效性。
(4) 要有数据输入。
(5) 要有结果输出。
算法的描述有许多方法,常用的有:自然语言、一般流程图、N-S图等。
第二章顺序结构程序设计第29页 1、2、3、4、5、6、7、8、91.简述符号常量与变量的区别?符号常量在程序运行过程中其值不能改变。
变量在程序运行过程中其值可以改变。
2. 下列符号中为合法的FORTRAN 90标识符的有哪些?(1) A123B (2) M%10 (3) X_C2 (4) 5YZ(5) X+Y (6) F(X) (7) COS(X) (8) A.2(9) ‘A’ONE (10) U.S.S.R.(11) min*2 (12) PRINT3. 下列数据中哪一些是合法的FORTRAN常量?(1) 9,87 (2) .0 (3) 25.82(4) -356231(5) 3.57*E2 (6) 3.57E2.1 (7) 3.57E+2(8) 3,57E-24. 已知A=2,B=3,C=5(REAL);且I=2,J=3(INTEGER),求下列表达式的值:(1) A*B+C 表达式的值: 11 (2) A*(B+C) 表达式的值: 16(3) B/C*A 表达式的值: 1.2 (4) B/(C*A) 表达式的值: 0.3(5) A/I/J 表达式的值: 0.33 (6) I/J/A 表达式的值: 0(7) A*B**I/A**J*2 表达式的值: 4.5(8) C+(B/A)**3/B*2. 表达式的值: 7.25(9) A**B**I 表达式的值: 5125. 将下列数学表达式写成相应的FORTRAN表达式:(1) 1E-2 (2)(-B+SQRT(B*B-4*A*C)/(2*A)(3) 1+X+X*X/2+X**3/2/3(4) COS(ATAN((A**3+B**3)**(1.0/3)/(C*C+1)))(5) EXP(A*X**2+B*X+C)(6) COS(X*Y/SQRT(X*X+Y*Y))**36. 用FORTRAN语句完成下列操作:(1) 将变量I的值增加1。
A Fortran to C Converter
Last updated March 22, 1995. Originally issued May 16, 1990.
∗Bell Communications Research, Morristown, NJ 07960 †Carnegie-Mellon University, Pittsburgh, PA 15213
March 22, 1995
பைடு நூலகம்
-2-
Although we have tried to make f 2c’s output reasonably readable, our goal of strict compatibility with f 77 implies some nasty looking conversions. Input/output statements, in particular, generally get expanded into a series of calls on routines in libI77, f 77’s I/O library. Thus the C output of f 2c would probably be something of a nightmare to maintain as C; it would be much more sensible to maintain the original Fortran, translating it anew each time it changed. Some commercial vendors, e.g., those listed in Appendix A, seek to perform translations yielding C that one might reasonably maintain directly; these translations generally require some manual intervention. The rest of this paper is organized as follows. Section 2 describes the interlanguage conventions used by f 2c (and f 77). §3 summarizes some extensions to Fortran 77 that f 2c recognizes. Example invocations of f 2c appear in §4. §5 illustrates various details of f 2c’s translations, and §6 considers portability issues. §7 discusses the generation and use of prototypes , which can be used both by C++ and ANSI C compilers and by f 2c to check consistency of calling sequences. §8 describes our experience with an experimental f 2c service provided by netlib [5], and §9 considers possible extensions. Appendix A lists some vendors who offer conversion of Fortran to C that one might maintain as C. Finally, Appendix B contains a man page telling how to use f 2c. 2. INTERLANGUAGE CONVENTIONS Much of the material in this section is taken from [6]. Names An f 2c extension inspired by Fortran 90 (until recently called Fortran 8x [2]) is that long names are allowed (f 2c truncates names that are longer than 50 characters), and names may contain underscores. To avoid conflict with the names of library routines and with names that f 2c generates, Fortran names may have one or two underscores appended. Fortran names are forced to lower case (unless the -U option described in Appendix B is in effect); external names, i.e., the names of Fortran procedures and common blocks, have a single underscore appended if they do not contain any underscores and have a pair of underscores appended if they do contain underscores. Thus Fortran subroutines named ABC, A_B_C, and A_B_C_ result in C functions named abc_, a_b_c_ _, and a_b_c_ _ _. Types The table below shows corresponding Fortran and C declarations; the C declarations use types defined in f2c.h, a header file upon which f 2c’s translations rely. The table also shows the C types defined in the standard version of f2c.h. ________________________________________________________ Fortran C standard f2c.h shortint x; short int x; integer∗2 x integer x integer x; long int x; logical x long int x; long int x; real x real x; float x; double x; double precision x doublereal x; complex x; struct { float r, i; } x; complex x double complex x doublecomplex x; struct { double r, i; } x; character ∗ 6 x char x[6]; char x[6]; ________________________________________________________ By the rules of Fortran, integer, logical, and real data occupy the same amount of memory, and double precision and complex occupy twice this amount; f 2c assumes that the types in the C column above are chosen (in f2c.h) so that these assumptions are valid. The translations of the Fortran equivalence and data statements depend on these assumptions. On some machines, one must modify f2c.h to make these assumptions hold. See §6 for examples and further discussion.
FORTRAN程序设计复习题及答案
FORTRAN程序设计复习题及答案FORTRAN程序设计复习题一、选择题B (1)下列各FORTRAN表达式中合法的是A) S+T*2P >= B) .NOT. (A*B+C)C) A2+B2/(C+D) <= D) (A+B).NOT.A*B.GT.(.NOT.只跟一个表达式)C (2)数学式(3/5)ex+y的FORTRAN表达式是A) 3*EXP(X+Y)/5 B) 3*E* *(X+Y)/C) (3/5)*EXP(X+Y)D) EXP(X+Y)D (3)下列FORTRAN77表达式中不合法的是A) A.GT.B.EQV.C.GT. D B) A.AND.B.AND.C.AND.DC) .NOT.(X.LE.D) A.LT.B.LT.C.LT.DD(4)下列叙述中不正确的是A) FORTRAN子程序可以单独编译B) 对一个FORTRAN源程序进行编译和连接无误后可生成可执行文件C) 即使编译和连接都正确无误,FORTRAN程序运行时仍可能出错D) FORTRAN连接的主要任务是把函数库中的函数翻译成机器指令(正确描述:主要任务为连接目标文件)B (5)在下列FORTRAN77运算符中,优先级最高的是A) .AND. B) .NOT. C) .OR. D) .EQ.B (6)FORTRAN表达式"6/5+9/2**3/2"的值为A) 33 B) 1 C) 5 D) 3A (7)下列FORTRAN77表达式中,合法的是:A) .AND.. B) 10.0C) D)提示:A)相当于 .AND.(.NOT.())D (8)关于编译一个FORTRAN源程序文件,下列说法中错误的是A) 允许编译只有一个主程序而没有子程序的源文件B) 允许编译有多个子程序的源文件C) 允许编译只有一个子程序而没有主程序的源文件D) 允许编译有多个主程序的源文件C (9)在FORTRAN77源程序中,续行标志符必须放在A) 第1列 B) 第1-6列C) 第6列D) 第5列D (10)下列关于"SUBROUTINE MAP(X,Y)"语句行的叙述中,不正确的是A) 这是子程序的第一个语句 B) 字符串"MAP"是子程序名C) 变量X是子程序的形参D) 子程序执行后,MAP将返回整型数据提示:子程序无返回值,自定义函数才有)A (11)FORTRAN表达式"2/4+"的值是A) B) 1 C) D) 0提示:2/4默认等于整型,=》D (12)FORTRAN表达式"MOD,"的值是A) B)0.0 C) D)A (13下列FORTRAN运算符中,优先级最低的是A)逻辑运算符.AND. B)算术运算符*C)关系运算符 >= D)算术运算符+A (14下列语句函数的定义中正确的是A)F(X,Y)=(X+Y)/(X*Y)+ B)FUNCTION FUN(I,J,K)=3*I +2*J+*K C)H(A,B,C(I))=SIN(A)+SIN(B)+C(I) D)S(A,B,C)=A*B+S(A*A,B,C)B(15下列标识符中,不属于FORTRAN常量的是A).TRUE. B)FALSE C)ˊROOT=ˊ D)ˊˊB(16)"整型变量M能被整型变量K整除"的FORTRAN77表达式是A)MOD(M,K)=0 (MOD(M,K)= =0)B)M-M/K*K .EQ. 0C)MOD(K,M)=0 D)MOD(M,K)=0 == .TRUE.C (17)设有下列数组说明语句: REAL:: A(1:10,-1:10)该数组说明语句定义了数组A 中的元素个数为 A )100 B )110 C )120 D )121 A (18)按隐含规则(默认为整型),语句IP=执行之后,IP 的值是A) 3 B) 3.1416C)D)D (19)下列数据中,不符合 FORTRAN 常量表示法的是A) B)C)‘FOOT’‘=’ D) TRUEC (20)设C 是复型变量,A 与B 为有定义的实型变量,下列赋值语句中合法的是A) C=A+BB) C=,**2) C) C=,3D-2)D) C=(A +B ,A-B )B (21)有矩阵(数组)=22221111B下列DATA 语句中正确的是A) DATA B/4*,4* B) DATA((B(I,J), J=1,4), I=1,2)/4*, 4* C) DATA B/4*,/ D) DATA((B(I,J),I=1,2), J=1,4)/4*, 4* C (21)在使用DO 循环及循环嵌套时,下列叙述中正确的是A) 不仅可以从循环体内转到循环体外,也可以从循环体外转到循环体内 B) 外循环与内循环的DO 循环控制变量可以不同.也可以相同C) 可以从循环体内转到循环体外,但不能从循环体外转到循环体内 D)DO 循环控制变量在循环体内可以再赋值,也可以被引用B (22)在FORTRAN 表达式中,各种运算的顺序是 A) 逻辑运算,关系运算,算术运算B) 算术运算,关系运算,逻辑运算C) 关系运算,逻辑运算,算术运算D) 关系运算,算术运算,逻辑运算D (23)赋值语句X=4**(6/12)=4**0=执行后,实型变量X的值是A) 2 B) 2.0 C) 1 D)D (24)为了保证正确出数据,格式编辑符中w与d的关系应该是A) w>d B) w>d+2 C) w>d+4 D) w>d+6C (25)设下列各语句中用到的数组都已定义,则下列语句中正确的是A) READ(*,*)(I,A(I),I=1,10) B)READ(*,*)(B,(I,J),I=1,10,J=1,10)C) READ(*,*)N,(A(I),I=1,N) D) READ(*,*)(I=1,10,A(I))A (26)下列DO语句中,不正确实现循环的是(I-N规则:I-N会被视为整型)A) DO 10 S=,, B) DO 10 K=,,C) DO 10 S=,, D) DO 10 K=,,D (27)下列说法中正确的是A) 块IF结构中的THEN块或ELSE块不能是空块B) 块IF结构中至少有一个ELSE IF 语句或ELSE语句C) 每个ELSE IF 语句要有一个对应的END IF语句D) 一个块 IF 结构中只能有一个END IF语句A (28)下列数组说明语句中正确的是A) INTEGER A(-1:5,0:6)B) REAL M(10:5)C) DOUBLE Y(1:N+1) D) DOUBLE Z(14)B (29)设有一个FORTRAN77子程序如下:SUBROUTINE SS(X,Y,S,T)S=X+Y(S,T为传出,即需要输出的(相当于求圆的面积中的area),只能T=X*Y 为确定的数;X,Y为传入(相当于radius),可为表达式)END调用上述子程序的正确语句是A) CALL SS,W*W,5,,Z)(多了一个)B) CALL SS,,P,Q,R) (多了一个)C) CALL SS(F,G,,D) CALL SS*I,*J,C,D)(I,J可先赋值)A (30)在下列语句函数的定义中正确的是A) F(X,Y)=(X+Y)/(X*Y)+B) FUNCTION(I,J,K)=3*I+2*J+*KC) H(A,B,C(I))=SIN(A)+SIN(B)+C(I) D) S(A,B,C)=A*B+S(A*A,B,C)B (31)COMMON语句的功能是A) 给同一程序模块中的若干变量分配同一存储单元B) 给不同程序模块中的变量分配相同的存储单元C) 给程序中任意两个变量分配相同的存储单元D) 给同一程序模块中的不同变量分配相同的存储单元B (32)下列表达式中值为整数4的是A) SQRT B)27/6 C) 16** D) 4*C(34)语句K=2+**2/2执行后,整型变量 K的值是A) B) 5 C) 6D) 7C (36)适用于字符型 I/O的 FORTRAN77格式编辑将是A) B) C) A D)D (37)给定子例行程序如下SUBROUTINE SUB(K,A)B=K+2(K为整型,B)错误;A不是整型,A)错误;K为传入,可为表达式,A=A+B A为传出,不能为表达式)END下列调用语句中正确的是A) CALL SUB(N,N) B) CALL SUB(X,X)C) CALL SUB(N+2,X) D) CALL SUB(N,X+3)C (38) 下列FORTRAN语句中,正确的是A) READ(*,*) (N,A(K),K=1,N) B) WRITE(*,*) (M(K,J),K=1,10,J=1,10)C) WRITE(*,*) (10,A(K),K=1,10) D) DATA A,B,C/2*C (39)对于下列给定的FORTRAN说明和赋初值语句:INTEGER A(2,2)DATA A/3,4,5,6/数组元数A(2,1)的初值为A) 3 B) 5 C) 4 D) 6C(40)下列对公用区的说明语句中错误的是A) COMMON A(5), B B) COMMON/AB/ A(5), BC) COMMON AB/A(5), B/ D) COMMONND. IF>=X<= Y=2*X+D) IF(X >= <= Y=2*X+二、阅读题1、阅读下列FORTRAN程序:program examplereal a,b,ca=b=c=write(*,"(3)") a,b,cend程序运行的结果是:2、阅读下列FORTRAN程序:program exampleinteger :: a=1integer :: b=2real :: cc=a/bwrite(*,"") cend程序运行结果是:3、阅读下列FORTRAN程序:program exampleimplicit noneinteger rain, windspeedwrite(*,*) "Rain:"read(*,*) rainwrite(*,*) "Wind:"read(*,*) windspeedIf ( rain>=500 .or. windspeed >=10 ) then write(*,*) "停止上班上课"elsewrite(*,*) "照常上班上课"end ifstopend运行上述程序时,如果从键盘输入Rain:505<回车>Wind:8<回车>则最后输出的结果为: 停止上班上课4、阅读下列FORTRAN程序:program exampleimplicit nonereal a,b,anscharacter operatorread(*,*) aread(*,"(A1)") operator read(*,*) bselect case(operator)case('+')ans = a+bcase('-')ans = a-bcase('*')ans = a*bcase('/')ans = a/bcase defaultwrite(*,"('Unknown operator ',A1)") operator stop end selectwrite(*,",A1,,'=',") a,operator,b,ansstopend运行上述程序时,如果从键盘输入100<回车><回车>200<回车>则最后输出的结果为: Unknown operator5、阅读下列FORTRAN程序:program exampleimplicit noneinteger iinteger strleninteger, parameter :: key = 2character(len=20) :: stringwrite(*,*) "Encoded string:"read(*,*) stringstrlen = len_trim(string)do i = 1, strlenstring(i:i) = char( ichar(string(i:i)) + key ) end dowrite(*,"('String:',A20)") stringstopendBCDIJK<回车>则最后输出的结果为: DEFKLM6、阅读下列FORTRAN程序:program exampleimplicit noneinteger i,jdo i=1, 2do j=2, 3, 2write(*, "(I2,I2)") i,jend dowrite(*,*) "another circle"end dostopend程序运行的结果是: 1 2another circle2 2another circle(按输出格式,1、2前均有一空格。
fortran常见问题解决
fortran常见问题解决为了减少重复回答问题,特编此帖,并不定期添加和更新内容。
错误难免,欢迎讨论,仅供参考。
很多人问哪里可以找到Fortran编译器,有不少热心学友提供网址,特汇集在这里。
虽然俺检验过这些链接,但是它们不一定总有效。
Fortran 编译器下载:CVFFTN95 (License: Free for personal use)以下操作,如无特别说明,都是以为例。
1. 如何加大Stack size?选Project => Settings => Link => Category: Output =>Stack allocationsReserve: 这里填新值(默认为1M,若需要10M,则填)2. 如何用Fortran批量生成文件?设要生成4000个文件,文件名为AA1-AA4000,如何写循环生成文件,而不用写4000次write 命令呢?用内部文件:character(len=80) :: filename,forminteger :: ido i=1,4000select case (i)case (1:9)write(form,'(i1)') icase (10:99)write(form,'(i2)') icase (100:999)write(form,'(i3)') icase (1000:9999)write(form,'(i4)') iend selectwrite(filename,*) "AA",trim(form),".TXT"open(10,file=filename)write(10,*) iclose(10)end dostopend3. 如何用Fortran动态生成输出格式?设有一个数组data(100),输出时,希望每行输出num个数,而num由用户输入,如何实现?用内部文件:character(len=80) :: formreal :: data(100)integer :: i,numdata = (/ (i,i=1,100) /)/read(*,*) numwrite(form,*) "(",num,""write(*,form) datastopend4. MS 是不是很垃圾?是垃圾,其中Bug太多,多到不可用的地步!在这个主题里,换了CVF后问题就没了的人已有相当的数目。
(易错题)高中数学必修三第二章《算法初步》测试(答案解析)(1)
一、选择题1.执行下面的程序框图,如果输入的a=4,b=6,那么输出的n=()A.3 B.4 C.5 D.6 2.若执行如图所示的程序框图,输出S的值为()A.2log23 B.log27 C.3 D.2 3.该程序中k的值是()A.9 B.10 C.11 D.124.若执行如图所示的程序框图,则输出S的值是()A.63 B.15 C.31 D.32t=-,则输出t的值等于( )5.执行如图的程序框图,若输入1A.3 B.5 C.7 D.156.执行如图所示的程序框图,若输出的结果为126,则判断框内的条件可以为()A .5n ≤B .6n ≤C .7n ≤D .8n ≤7.执行如下的程序框图,则输出的S 是( )A .36B .45C .36-D .45-8.执行如图所示的程序框图,若输人的n 值为2019,则S =A.B.C.D.9.我国明朝数学家程大位著的《算法统宗》里有一道闻名世界的题目:一百馒头一百僧,大僧三个更无争,小僧三人分一个,大小和尚各几个?程序框图反映了对此题的一个求解算法,则输出n的值为()A.20B.25C.75D.8010.某程序框图如图所示,若运行该程序后输出S ()A.53B.74C.95D.11611.执行如图的程序框图,则输出x的值是 ()A.2018B.2019C.12D.212.执行如图所示的程序框图,若输出的结果为48,则输入k的值可以为A.6B.10C.8D.4二、填空题13.按下列程序框图运算:规定:程序运行到“判断结果是否大于244”为1次运算.若运算进行3次才停止,则x的取值范围是__________.14.执行下面的程序框图,若输入的a,b,k分别为1,2,3,则输出的M _____15.我国元朝著名数学家朱世杰在《四元玉鉴》中有一首诗:“我有一壶酒,携着游春走,遇店添一倍,逢友饮一斗,店友经三处,没有壶中酒,借问此壶中,当原多少酒?”用程序框图表达如图所示,即最终输出的0x =,问一开始输入的x =______斗.遇店添一倍,逢友饮一斗,意思是碰到酒店就把壶里的酒加1倍,碰到朋友就把壶里的酒喝一斗,店友经三处,意思是每次都是遇到店后又遇到朋友,一共是3次.16.执行如图所示的程序框图,若输入的,a k 分别是89,2,则输出的数为__________.17.已知一个算法的程序框图如图所示,当输入的1x =-与1x =时,则输出的两个y 值的和为__________.18.已知多项式函数5432()254367f x x x x x x =--+-+,当5x =时由秦九韶算法知012,2555,v v ==⨯-=则3v =_________.19.运行右图所示程序框图,若输入值xÎ[-2,2],则输出值y的取值范围是_____.20.如果执行如图所示的程序框图,那么输出的值k= .三、解答题21.某林业部门为了保证植树造林的树苗质量,对甲、乙两家供应的树苗进行根部直径检测,现从两家供应的树苗中各随机抽取10株树苗检测,测得根部直径如下(单位:mm):甲27112110190922131523乙15202717211416182418(1)画出甲、乙两家抽取的10株树苗根部直径的茎叶图,并根据茎叶图对甲、乙两家树苗进行比较,写出两个统计结论;(2)设抽测的10株乙家树苗根部直径的平均值为x ,将这10株树苗直径依次输入程序框图中,求输出的S 的值,并说明其统计学的意义.22.写出一个求解任意二次函数()20y ax bx c a =++≠的最值的算法.23.求两底面半径分别为2和4,高为5的圆台的表面积及体积.写出解决该问题的一个算法,并画出程序框图.24.如图,已知单位圆221x y +=与x 轴正半轴交于点P ,当圆上一动点Q 从P 出发沿逆时针旋转一周回到P 点后停止运动.设OQ 扫过的扇形对应的圆心角为xrad ,当02x π<<时,设圆心O 到直线PQ 的距离为y ,y 与x 的函数关系式()y f x =是如图所示的程序框图中的①②两个关系式.(1)写出程序框图中①②处的函数关系式;(2)若输出的y 值为12,求点Q 的坐标. 25.试编写程序确定S=1+4+7+10+…中至少加到第几项时S ≥300.26.设计一个算法,已知函数2x y =的图象上,任意给定两点的横坐标1x 和212()x x x ≠,求过这两点的直线的斜率,并画出程序框图.【参考答案】***试卷处理标记,请不要删除一、选择题 1.B 解析:B 【解析】试题分析:模拟执行程序, 可得4,6,0,0a b n s ====,执行循环体,2,4,6,6,1a b a s n =====,不满足条件16s >,执行循环体,2,6,4,10,2a b a s n =-====, 不满足条件16s >,执行循环体,2,4,6,16,3a b a s n =====, 不满足条件16s >,执行循环体,2,6,4,20,4a b a s n =-====,不满足条件16s >,退出循环, 输出n 的值为4,故选B. 考点:1、程序框图;2、循环结构.2.C解析:C 【解析】由题意,可得程序的功能是求S =log 23×log 34×log 45×log 56×log 67×log 78的值,原式=×××××==3.故选C.3.B解析:B 【分析】本题只要按照程序框图规定的运算方法逐次计算,直到达到输出条件即可(注意避免计算错误). 【详解】3,2,8,814x k y ===<,第一次循环,4,10,1014k y ==<; 第二次循环,6,12,1214k y ==<; 第三次循环,8,14,1414k y ===; 第四次循环,10,16,1614k y ==>, 退出循环,输出10k =,故选:B. 【点睛】本题主要考查程序框图的循环结构流程图,属于中档题. 解决程序框图问题时一定注意以下几点:(1) 不要混淆处理框和输入框;(2) 注意区分程序框图是条件分支结构还是循环结构;(3) 注意区分当型循环结构和直到型循环结构;(4) 处理循环结构的问题时一定要正确控制循环次数;(5) 要注意各个框的顺序,(6)在给出程序框图求解输出结果的试题中只要按照程序框图规定的运算方法逐次计算,直到达到输出条件即可.4.C解析:C 【分析】根据程序框图模拟程序计算即可求解. 【详解】模拟程序的运行,可得1S =,1i =; 满足条件5i <,执行循环体,3S =,2i =; 满足条件5i <,执行循环体,7=S ,3i =; 满足条件5i <,执行循环体,15S =,4i =; 满足条件5i <,执行循环体,31S =,5i =; 此时,不满足条件5i <,退出循环,输出S 的值为31. 故选:C 【点睛】本题主要考查了程序框图,循环结构,属于中档题.5.C解析:C 【分析】直接根据程序框图依次计算得到答案. 【详解】模拟执行程序,可得1t =-,不满足条件0t >,0t =,满足条件()()250t t +-<, 不满足条件0t >,1t =,满足条件()()250t t +-<, 满足条件0t >,3t =,满足条件()()250t t +-<,满足条件0t >,7t =,不满足条件()()250t t +-<,退出循环,输出t 的值为7. 故选:C. 【点睛】本题考查了程序框图,意在考查学生的计算能力和理解能力.6.B解析:B【分析】根据框图,模拟程序运行即可求解. 【详解】根据框图,执行程序,12,2S n ==;1222,3S n =+=;⋯12222,1i S n i =++⋯+=+,令12222126i S =++⋯+=, 解得6i =,即7n =时结束程序, 所以6n ≤, 故选 :B 【点睛】本题主要考查了程序框图,循环结构,条件分支结构,等比数列求和,属于中档题.genju7.A解析:A 【分析】列出每一步算法循环,可得出输出结果S 的值. 【详解】18i =≤满足,执行第一次循环,()120111S =+-⨯=-,112i =+=; 28i =≤成立,执行第二次循环,()221123S =-+-⨯=,213i =+=; 38i =≤成立,执行第三次循环,()323136S =+-⨯=-,314i =+=; 48i =≤成立,执行第四次循环,()4261410S =-+-⨯=,415i =+=; 58i =≤成立,执行第五次循环,()52101515S =+-⨯=-,516i =+=; 68i =≤成立,执行第六次循环,()62151621S =-+-⨯=,617i =+=;78i =≤成立,执行第七次循环,()72211728S =+-⨯=-,718i =+=; 88i =≤成立,执行第八次循环,()82281836S =-+-⨯=,819i =+=; 98i =≤不成立,跳出循环体,输出S 的值为36,故选A. 【点睛】本题考查算法与程序框图的计算,解题时要根据算法框图计算出算法的每一步,考查分析问题和计算能力,属于中等题.8.B解析:B 【分析】根据程序框图可知,当时结束计算,此时 .【详解】计算过程如下表所示:周期为6 n 2019k 1 2 (2018)2019S…k<n 是是是是否【点睛】本题考查程序框图,选用表格计算更加直观,此题关键在于判断何时循环结束.9.B解析:B 【分析】根据程序的运行过程,依次得到,,n m S 的值,然后判断是否满足100S =,结合循环结构,直至得到符合题意的n . 【详解】执行程序框图,8026020,1002080,32010033n m S ==-==⨯+=≠; 则7926821,1002179,6310033n m S ==-==+=≠; 则7822,1002278,66921003n m S ==-==+=≠; 则7728423,1002377,6910033n m S ==-==+=≠; 则7629224,1002476,7210033n m S ==-==+=≠; 则7525,1002575,751003n m S ==-==+=成立, 故输出25n =. 故答案为B. 【点睛】本题主要考查了程序框图,考查了学生的逻辑推理能力,属于基础题.10.D解析:D 【分析】通过分析可知程序框图的功能为计算211n S n +=+,根据最终输出时n 的值,可知最终赋值S 时5n =,代入可求得结果. 【详解】根据程序框图可知其功能为计算:()111111111211111112231223111n S n n n n n n +=+++⋅⋅⋅+=+-+-+⋅⋅⋅+-=+-=⨯⨯++++初始值为1n =,当6n =时,输出S 可知最终赋值S 时5n = 25111516S ⨯+∴==+ 本题正确选项:D 【点睛】本题考查根据程序框图的功能计算输出结果,关键是能够明确判断出最终赋值时n 的取值.11.D解析:D 【分析】模拟执行程序框图,依次写出每次循环得到的x ,y 的值,当2019y = 时,不满足条件退出循环,输出x 的值即可得解. 【详解】解:模拟执行程序框图,可得2,0x y ==.满足条件2019y <,执行循环体,1,1x y =-=;满足条件2019y <,执行循环体,1,22x y == ; 满足条件2019y <,执行循环体,2,3x y ==;满足条件2019y <,执行循环体,1,4x y =-= ; …观察规律可知,x 的取值周期为3,由于20196733⨯=,可得: 满足条件2019y <,执行循环体,当2,2019x y == ,不满足条件2019y <,退出循环,输出x 的值为2. 故选D . 【点睛】本题主要考查了循环结构的程序框图,依次写出每次循环得到的x ,y 的值,根据循环的周期,得到跳出循环时x 的值是解题的关键.12.C解析:C 【分析】执行如图所示的程序框图,逐次循环,计算其运算的结果,根据选项即可得到答案. 【详解】由题意可知,执行如图所示的程序框图,可知: 第一循环:134,2146n S =+==⨯+=; 第二循环:437,26719n S =+==⨯+=; 第三循环:7310,2191048n S =+==⨯+=, 要使的输出的结果为48,根据选项可知8k ,故选C.【点睛】本题主要考查了循环结构的计算与输出问题,其中解答中正确理解循环结构的程序框图的计算功能,逐次准确计算是解答的关键,着重考查了运算与求解能力,属于基础题.二、填空题13.【分析】根据题意得到不等式和计算得到答案【详解】根据题意知:且故故答案为:【点睛】本题考查了程序框图没有考虑完整情况是容易发生的错误 解析:(]10,28【分析】根据题意得到不等式()3322244x --≤和()333222244x --->⎡⎤⎣⎦,计算得到答案. 【详解】根据题意知:()332224428x x --≤∴≤且()33322224410x x --->∴>⎡⎤⎣⎦ 故(]10,28x ∈ 故答案为:(]10,28 【点睛】本题考查了程序框图,没有考虑完整情况是容易发生的错误.14.12【分析】由题意可知从开始判断框条件成立执行第一次循环得到一组新的的值再从开始判断框条件成立执行第一次循环得到一组新的的值当时判断条件框不成立输出此时的值即可得出答案【详解】当时执行程序框图得;当解析:12 【分析】由题意可知,从1n =开始,判断框条件成立,执行第一次循环,得到一组新的,,M a b 的值,再从2n =开始,判断框条件成立,执行第一次循环,得到一组新的,,M a b 的值,当3n =时,判断条件框不成立,输出此时M 的值,即可得出答案. 【详解】当1n =时,执行程序框图得,1225,2,5M a b =+⨯===; 当2n =时,执行程序框图得,22512,5,12M a b =+⨯===; 当3n =时,不满足判断条件框,直接输出 12M =.故答案为12.【点睛】本题主要考查了根据程序框图写出执行结果的问题,对于这类题目,首先要弄清框图的结构和执行过程,本题为循环结构的程序框图.15.【分析】模拟执行程序框图只要按照程序框图规定的运算方法逐次计算直到达到输出条件输出令即可得结果【详解】第一次输入执行循环体执行循环体执行循环体输出的值为0解得:故答案为【点睛】本题主要考查程序框图的解析:78【分析】模拟执行程序框图,只要按照程序框图规定的运算方法逐次计算,直到达到输出条件输出87x -,令870x -=即可得结果. 【详解】第一次输入x x =,1i =执行循环体,21x x =-,2i =,执行循环体,()221143x x x =--=-,3i =, 执行循环体,()243187x x x =--=-,43i =>, 输出87x -的值为0,解得:78x =, 故答案为78. 【点睛】本题主要考查程序框图的循环结构流程图,属于中档题. 解决程序框图问题时一定注意以下几点:(1) 不要混淆处理框和输入框;(2) 注意区分程序框图是条件分支结构还是循环结构;(3) 注意区分当型循环结构和直到型循环结构;(4) 处理循环结构的问题时一定要正确控制循环次数;(5) 要注意各个框的顺序,(6)在给出程序框图求解输出结果的试题中只要按照程序框图规定的运算方法逐次计算,直到达到输出条件即可.16.1011001【解析】模拟程序框图的运行过程如下;输入a=89k=2q=89÷2=44…1;a=44k=2q=44÷2=22…0;a=22k=2q=22÷2=11…0;a=11k=2a=11÷2=5解析:1011001 【解析】模拟程序框图的运行过程,如下; 输入a=89,k=2,q=89÷2=44…1; a=44,k=2,q=44÷2=22…0; a=22,k=2,q=22÷2=11…0; a=11,k=2,a=11÷2=5…1; a=5,k=2,q=5÷2=2…1; a=2,k=2,q=2÷2=1…0;a=1,k=2,q=1÷20…1; 则输出的数为1011001. 故答案为:1011001.17.【解析】时时输出的两个值的和为故答案为解析:54【解析】1x =-时,11124y --==,1x =时,()2log 111y =+=,15144∴+=,输出的两个y 值的和为54,故答案为54. 18.【解析】试题分析:当时考点:秦九韶算法 解析:【解析】 试题分析:,当时,,考点:秦九韶算法19.【解析】试题分析:由程序框图可得到一个分段函数因此本题实质为根据定义域xÎ-22求值域当时当时所以值域为考点:流程图函数值域 解析:[1,4]-【解析】试题分析:由程序框图可得到一个分段函数2,0(){(2),0x x f x x x x -<=-≥,因此本题实质为根据定义域xÎ[-2,2],求值域.当[2,0)x ∈-时,()(0,4];f x ∈当[0,2]x ∈时,()[1,0];f x ∈-所以()f x 值域为(0,4][1,0][1,4].⋃-=- 考点:流程图,函数值域.20.4【分析】模拟执行程序框图依次写出每次循环得到的S 的值当S=2059k=4时不满足条件S <100退出循环输出k 的值为4【详解】模拟执行程序框图可得k=0S=0满足条件S <100S=1k=1满足条件S解析:4 【分析】模拟执行程序框图,依次写出每次循环得到的S 的值,当S =2059,k =4时,不满足条件S <100,退出循环,输出k 的值为4. 【详解】模拟执行程序框图,可得 k =0 S =0满足条件S <100,S =1,k =1 满足条件S <100,S =3,k =2 满足条件S <100,S =11,k =3 满足条件S <100,S =2059,k =4不满足条件S <100,退出循环,输出k 的值为4. 故选B . 【点睛】本题主要考查程序框图的循环结构流程图,属于中档题. 解决程序框图问题时一定注意以下几点:(1) 不要混淆处理框和输入框;(2) 注意区分程序框图是条件分支结构还是循环结构;(3) 注意区分当型循环结构和直到型循环结构;(4) 处理循环结构的问题时一定要正确控制循环次数;(5) 要注意各个框的顺序,(6)在给出程序框图求解输出结果的试题中只要按照程序框图规定的运算方法逐次计算,直到达到输出条件即可.三、解答题21.(1)见解析(2)15,见解析 【分析】(1)由题意画出茎叶图,根据茎叶图写出两条合理结论即可;(2)计算出x ,根据程序框图的功能是计算出数据方差,计算方差,说出方差的统计学意义即可得解. 【详解】(1)茎叶图如图所示:结论有:①甲家树苗的平均直径小于乙家树苗的平均直径; ②乙家树苗比甲家树苗长的更均匀;③甲家树苗的中位数是17,乙家树苗的中位数是18.(答案合理即可给分,写出两条即可).(2)由题意()1151714161818202721241910x =+++++++++=, 因为该程序框图的算法功能是求数据方差,所以2221[(1519)(1719)(2419)]1510S =-+-++-=,S 是10株树苗根部直径的方差,是描述离散程度的量,S 越小,长得越整齐,S 越大,长得越粗细不均. 【点睛】本题考查了茎叶图和程序框图的应用,考查了数据方差的概念和计算,属于中档题.22.见解析 【分析】由二次函数的性质知,当0a >时,二次函数()20y ax bx c a =++≠开口方向向上,函数有最小值为244ac b a -;当0a <时, 二次函数()20y ax bx c a =++≠开口方向向下,函数有最大值为244ac b a-. 【详解】第一步,输入a ,b ,c第二步,计算244ac b m a-=;第三步,若0a >,min y m =,否则, max y m =. 【点睛】本题考查算法步骤的书写和一元二次函数的最值问题;同时让学生体会算法在解决数学问题中的作用;求解本题的关键是对一元二次函数最值情况必须熟悉;属于中档题. 23.见试题解析. 【解析】 【分析】根据圆台的体积和表面积公式依次按顺序输入公式,写成顺序结构即可. 【详解】 算法步骤如下:第一步:12r =,24r =,5h =.第二步:计算l =第三步:计算211S r π=,222S r π=,()312S r r l π=+.第四步:计算123S S S S =++,()1213V S S h =. 第五步:输出S 和V . 程序框图如下图所示.【点睛】(1)程序框图是流程图的一种,程序框图有一定的规范和标准,而日常生活中的流程图则相对自由一些,可以使用不同的色彩,也可以添加一些生动的图形元素.(2)画算法的程序框图,一般需要将自然语言描述的算法的每一个步骤分解为若干输入、输出、条件结构、循环结构等基本算法单元,然后根据各单元的逻辑关系,用流程线将这些基本单元连接起来.即基本单元是构成程序框图的基本要素,基本要素之间的关系由流程线建立. 24.(1)cos 2x y =,cos 2x y =-. (2) 13(,2-. 【详解】分析:(1)利用三角函数的定义与性质求出两种情况下y 与x 的函数关系式,即可得结果;(2)0x π<≤时,1cos22x =,得23x π=,此时点Q 的坐标为132⎛- ⎝⎭;当2x ππ<<时,1cos 22x -=,得43x π=,此时点Q 的坐标为13,22⎛-- ⎝⎭. 详解:(1)当0x π<≤时,cos2x y =;当2x ππ<<时,cos cos 22x x y π⎛⎫=-=- ⎪⎝⎭;综上可知,函数解析式为()(](),0,2,,22x cos x f x x cos x πππ⎧∈⎪⎪=⎨⎪-∈⎪⎩所以框图中①②处应填充的式子分别为cos 2x y =,cos 2xy =-. (2)若输出的y 值为12,则0x π<≤时,1cos22x =,得23x π=,此时点Q的坐标为12⎛- ⎝⎭; 当2x ππ<<时,1cos 22x -=,得43x π=,此时点Q的坐标为1,2⎛- ⎝⎭. 点睛:本题主要考查条件语句以及算法的应用,属于中档题 .算法是新课标高考的一大热点,其中算法的交汇性问题已成为高考的一大亮,这类问题常常与函数、数列、不等式等交汇自然,很好地考查考生的信息处理能力及综合运用知识解决问題的能力,解决算法的交汇性问题的方:(1)读懂程序框图、明确交汇知识,(2)根据给出问题与程序框图处理问题即可. 25.答案见解析【解析】试题分析:直接利用已知条件和循环语句编写算法程序. 试题 程序如下: S=0; n=1; i=0; while S<300 S=S+n; n=n+3; i=i+1; end i=i-1 print “i=”;i 26.见解析 【解析】试题分析:输入12,x x ,然后计算112x y =,222xy =和1212y y k x x -=-,最后输出,利用顺序结构的程序框图表示即可. 试题 算法如下:第一步:输入12,x x .第二步:计算112xy =.第三步:计算222xy =.第四步:计算1212y y k x x -=-. 第五步,输出k . 程序框图下:。
fortran 排除错误
安装好VISUAL FORTRAN后1、运行Developer studio即可开始编译FORTRAN程序2、选择File菜单中的New选项3、在弹出的对话框选择projects标签,其他标签不用管,projects格式选用Fortran console application;在project name里命名(最好英文名),点击“ok ”4、接下来画面中,选择“an empty project”,点击“finish”5、接下来画面点击“ok”6、再选择一次File菜单中的new7、对话框选用files标签,选择Fortran free format source file ,并在file里命名8、点击“ok”Source Files 放源文件(.c、.cpp)程序的实现代码全放在这里Header Files 放头文件(.h)声明放在这里Resource Files 资源文件(.rc)放图标、图片、菜单、文字之类的,主要用来做界面的东东一般都放这里External Dependencies 除上三种以外的,程序编译时用到的文件全放这里fortran内部函数出错信息解释内部函数出错信息解释[sourcefile(line)]run-time error M62××MATH错误号函数级数学错误信息M6201 functionnames:DOMAIN error函数的自变量超出了约定的取值域,例如sqrt(-1)M6202 functionname:SING error无意义的变量。
例如log10(0)M6203 functionname:OVERFLOW error函数的结果值或其中一个既时计算值太大以致不能表示,例如EXP(250000.0) M6204 functionname:UNDERFLOW error函数的结果值或其中一个既时计算值太小以致不能表示。
M6205 functionname:TLOSS error完全丢失精度,例如COS(1E30)M6206 functionname:PLOSS errorfortran debug模式设置和技巧CVF中有两种编译(连接、执行)模式:release模式和debug模式。
Fortran(A)
Fortran(A)南京信息⼯程⼤学试卷2009-2010学年第 1学期 FORTRAN 程序设计课程试卷( A 卷)本试卷共 7 页;考试时间 120 分钟;任课教师宣⽂霞;出卷时间 2009 年 12 ⽉数理学院学院专业 2008 年级班学号姓名得分⼀、单项选择题(每⼩题 2 分,共 40 分)1. 下⾯叙述中正确的是。
A )Fortran 程序中各类语句的位置是任意的B )Fortran 程序中的所有可执⾏语句在程序执⾏时都会产⽣机器操作C )Fortran 程序中的每⼀⾏上都可含有标号D )Fortran 程序中的任何语句在程序执⾏时都会产⽣某种机器操作 2. 在Fortran 中 2sin()/(2)x e x a 的正确的算术表达式为。
A )EXP(X)+SIN(X**2)/(2*A)B )EXP(X)+SIN(X**2)/2*AC )E**X+SIN(X**2)/(2*A)D )EXP(X)+SIN(X*2)/(2*A) 3. 与表达式0A ) 0.0 < X < 5.0B ) 0.0 > X < 5.0C ) 0.0 < X .AND. 5.0 > XD ) X > 0.0 .OR. X< 5.0 4. 在下⾯写法中,不是Fortran 常量的是。
A )200,000B ) (11.0, 23.4)C ) 1.23D-22D ) .TRUE. 5. 已知各变量类型由“I -N 规则”确定,且J=2、B=7.5,执⾏下列赋值语句A=J**2*(6/8)+0.6-B后,则变量A 的值为。
A )-3.9B ) 3.9C ) 6.9D ) -6.9 6. Fortran 程序从编写到完成计算,⽣成三种主要的⽂件,按其扩展名表⽰,它们依次是。
A ) *.f90, *.com, *.batB ) *.f90, *.obj, *.exe C) *.f90, *.obj, *.com D )*.for, *.bat, *.exe 7. 下列符号中,可作为FORTRAN 合法变量名的是。
北京邮电大学出版社FORTRAN程序设计课后习题答案2
北京邮电大学出版社FORTRAN程序设计课后习题答案2北京邮电大学出版社FORTRAN程序设计课后习题答案2 PROGRAM EX3_4CHARACTER*1 LETTER!方法一print*,' 请输入一个英文字母:'READ*,LETTERif(LETTER>='A' .and. LETTER<='Z') THENwrite(*,*)' 你输入的',LETTER,'为大写字母。
'elseif(LETTER>='a' .and. LETTER<='z')THENwrite(*,*)' 你输入的',LETTER,'为小写字母。
'elsewrite(*,*)' 你输入的',LETTER,'不是字母。
'endif!方法二print*,' 请输入一个英文字母:'READ*,LETTERSELECT CASE(LETTER)CASE('A':'Z')write(*,*)' 你输入的',LETTER,'为大写字母。
'CASE('a':'z')write(*,*)' 你输入的',LETTER,'为小写字母。
'CASE DEFAULTwrite(*,*)' 你输入的',LETTER,'不是字母。
'ENDSELECT!方法三print*,' 请输入一个英文字母:'READ*,LETTERI=ICHAR(LETTER) !转化字符LETTER为对应的ASCII值if(i>=65 .and. i<=90) write(*,*)' 你输入的',LETTER,'为大写字母。
郑玉FORTRAN题库
一、选择题:1. 若有INTEGER B(-5:0,-1:1),则数组B 中所含的元素为__________。
A. 18B.9C.6D.42. 在Fortran 中 2sin()/(2)x e x a 的正确的算术表达式为 。
A )EXP(X)+SIN(X**2)/(2*A)B )EXP(X)+SIN(X**2)/2*AC )E**X+SIN(X**2)/(2*A)D )EXP(X)+SIN(X*2)/(2*A)3. 下列名称中,符合FORTRAN 90命名规则的是 。
A )M%8B )A123BC )F(x)D )5xy4. 在下面的常量写法中,不是Fortran 常量的是 。
A )4.567E-4B )(1,3)C )… ‟D )true5. 下面程序的运行结果是 。
(□表示空格)character( len=11):: s1,s2s1 = ‘IT □IS □EASY!’s2 = ‘IS ’//‘IT ’//s1(7:10)// ‘?’print*, s2endA. ISITEASY?B. IS □IT □EASY?C. ISITEASY?□□D. □□ISITEASY?6. Fortran 90程序从编写到运行,生成三种主要的文件,按其扩展名表示,它们依次是 。
A ) *.f90, *.obj, *.exeB ) *.f90, *.com, *.batC) *.f90, *.obj, *.com D )*.for, *.bat, *.exe7. 下列程序中,循环语句执行完后,输出k 和m 的值分别是 。
DO m=0 ,7k = 1+ mENDDOPrint *, k, mA )7,7B ) 7,8C )8,8D )8,98. 下面程序运行时执行循环体的次数是 。
K=0DO J = -1, -8, 2K=K+1END DOA) 3 B) 2 C) 1 D) 09. 若实型变量X=27.0,Y=3.0,则下面FORTRAN 表达式的值是 。
fortran程序实例
1)实例3—求多个半径下的圆周长! z3.f90 --Fortran95! FUNCTIONS:! z3 - Entry point of console application.!************************************************************************* ! PROGRAM: z3! PURPOSE: Entry point for the console application.!************************************************************************ 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.1415926C=2*PI*RRETURN! Body of z3end2)实例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_Oimplicit none!变量声明的位置INTEGER(2) i; INTEGER(4) j; INTEGER(4) m; REAL nINTEGER A,B! VariablesPRINT*,'输入整数A'; READ*, APRINT*,'输入整数B'; READ*, BB=A+BPRINT*,'B=A+B=',BWRITE(*,*) 'A*B=',A*BPRINT* ,'以上为计算机的计算结果,注意B的值'!系统默认的输出样式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_O程序说明:程序赋值—初始化i=21; j=53; m=5键盘无格式输入READ*, A键盘有格式输入READ(*, 100)A,B,C100 FORMA T( 2F5.2,F5.3)显示器无格式输出PRINT* ,'系统默认的输出样式' WRITE(*,*) 'A*B=',A*B显示器有格式输出PRINT 100 ,A+BWRITE(*,100) 'A*B=',A*B100 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_Oimplicit none!变量声明的位置INTEGER(2) i; INTEGER(4) j; INTEGER(4) m; REAL nINTEGER A,BREAL X,Y,Z! VariablesPRINT*,'输入整数A'; READ*, APRINT*,'输入整数B'; READ*, BPRINT*, '计算结果为:'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_O e)调试运行。
- 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。
program has found many problems
2)
Method Finite difference methods, dating back to Gauss 6) can be used to obtain for all static electric and fields where eddy currents can The
W
, W
, W
x
Ch 2 x
y
Ch 2 y
z
i =-Ch 2 z
and
For cylindrical
co-ordinates
with rotational
W
symmetry
¢0 = Wx(¢l+~2 ) + Wy(¢3+¢4)+ - - ~ (~4-~3)
- 0/C
where
C =-2 h2 x
+ -2 , h2 y
others4, 5) with the idea in mind that appropriate for it at some future date when computers Fortunately,
could run it in a practical manner.
our view into the crystal ball turned out to be accurate and the to solve both at TRIUMF and elsewhere.
is shown in Fig. I for the Poisson equation equation
W z (~ 5+~ 6) = - -I
in the finite difference
¢0 = Wx(¢ I+~ 2) +
W y (¢ 3+¢ 4) + : - -i
0/C
where
C : - - + - - 12 2 2 , h2 h2 h2 x y z 0 = 0 (x0,Y0,Z0)
the boundary having the dominant effect. Although restricting the boundaries to lie on the grid (mesh) points limits the resolution with which one can describe a particular geometry (given the maximum number of allowed grid points) this greatly simplifies the program structure and consequently its execution speed.
I < R < 2
The patterns called
of points used to form the finite difference "molecules" or "stencils".
equations
are commonly
"templates",
Y
Let the uniform grid spacing along the x, y , and z axes
by replacing
the old ~ by
*Current address Physics Department, Vancouver, B.C., Canada.
University
of British Columbia,
99
Cold
+ R * (¢0 - ~old ) where usually
W
= - -1
, W
x
Ch 2 x
y
i =-Ch 2 2 Y and axis of symmetry is along x axis and radius R is along y axis, W : while for R = 0 (on axis)
¢0 = Wx(¢i+¢2) + w
2 +4 C =--- , h2 h2 x y
Y
¢~W
p/c
=--
i Ch 2' x
W
=-y
4 Ch 2 y
x
p = p (x0,Y0) = p(z,R)
100
3.
Boundaries RELAX3D handles three types of boundaries. The first type is a DIRICHLET
¢ at each grid point (that is allowed equation.
to vary) on each iteration is The over-relaxation method
replaced using the finite - difference accelerates the convergence
be hx, hy, and h z respectively where in general be different. these may all
~Y
/
~
o hx
'1
0~/
/T hx ~._x
hy
Z
~3
The 3 dimensional resulting molecule
FIG,'J.
V~ = 0
the problem case, the iterations
and the contour plotting of any desired slices etc. in 1973 3) based on work by applications would be found
Basic parts of the program were developed
partial differential difference interest, equations
for the field, being replaced by a set of finite the volume of the potential ~ at
at discrete points in a mesh occupying connecting
of Dirichlet
and Neumann boundaries
regular 3 dimensional mesh. solved using a successive of commands, supplemented
The finite difference
equations
at these nodes are
A Fortran Program (RELAX3D) to Solve the 3 Dimensional Poisson (Laplace) Equation
H. Houtman*,
C.J. Kost
TRIUMF, University of British Columbia Vancouver, B.C., Canada
boundaries must be restricted to lie on the grid points their precise position is not very important to the fields a few mesh points away, only the existence of
user written subroutine BND (describing the user problem geometry) and consequently will not be allowed to change during the relaxation procedure. The second type is a NEUMANN boundary. All or some of the points on the The
numerical magnetic
solutions,
to any desired accuracy,
fields in uniform media and time-varying We will restrict ourselves equation
be neglected.
to problems given in TABLE I.
boundary, that is a boundary (usually metal) on which the potential ~ is known (and hence fixed). These boundary points are always specified as negative in the
results in a large number of equations
each point with those of adjacent points and is solved by an iterative procedure known as relaxation. potential The basis of the iteration procedure is that the
faces of the 3 dimensional box (cylinder) can be of this type (default).
charge density, permittivity (where applicable) and potential on adjacent points orthogonal to such a symmetry plane point (one inside the box and the other a "fictitious" one outside the box) are assumed to be equal and hence the normal gradients of charge density, permittivity and potential are zero for these symmetry boundary points. NEUMANN boundaries. The third type is a dielectric boundary between two media of different permittivity (currently restricted to 2D problems). Although dielectric Thus equipotential lines always cross perpendicular to