计算数学精解【13】-fortran计算精解（2）

read,write

读写文件

program learnimplicit nonecharacter(10)::student_namecharacter(20)::file_nameinteger::idinteger::io_statuscharacter(100)::err_msgreal::math_score,english_score,politics_scorewrite(*,*) "请输入文件名:"read (*,*)  file_namewrite(*,*) "请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):"read (*,*) id,student_name,math_score,english_score,politics_scoreopen (unit=11,file=file_name,status='replace',action='write',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "写入文件",file_name,"异常"elsewrite (11,100) id,student_name,math_score,english_score,politics_scoreclose(unit=11)endifopen (unit=10,file=file_name,status='old',action='read',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "读取文件",file_name,"异常"elseread (10,100) id,student_name,math_score,english_score,politics_scorewrite (*,100) id,student_name,math_score,english_score,politics_scoreclose(unit=10)endif100 format(I5,A10,3F6.2)end program learn

录入与读取数据

 请输入文件名:
test.dat请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
1,ads,dsf,adsf,adf,adsf请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
2,asfd,asdf,adsf,345请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
3,张三,98.32,68.88,91.34录入成功！继续录入吗？(y/n)
n3张三       98.32 68.88 91.34Process returned 0 (0x0)   execution time : 35.250 s
Press any key to continue.

program learnimplicit nonecharacter(10)::student_namecharacter(20)::file_namecharacter(1)::is_continue_input,ansinteger::idinteger::io_statusinteger::read_statusinteger::write_statuscharacter(100)::err_msgreal::math_score,english_score,politics_scorewrite(*,*) "请输入文件名:"read (*,*)  file_nameopen (unit=11,file=file_name,status='replace',action='write',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "写入文件",file_name,"异常:",err_msgelsewrite_file:dowrite(*,*) "请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):"read (*,*,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0) cyclewrite(11,100,iostat=write_status) id,student_name,math_score,english_score,politics_scoreif (write_status==0) write (*,*) "录入成功！"write (*,*) "继续录入吗？(y/n)"read(*,*) is_continue_inputif (is_continue_input=='n' .or. is_continue_input=='N') exitend do write_fileclose(unit=11)endifopen (unit=10,file=file_name,status='old',action='read',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "读取文件",file_name,"异常:",err_msgelseread_file:doread (10,100,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0) exitwrite (*,100) id,student_name,math_score,english_score,politics_scoreend do read_fileclose(unit=10)endif100 format(I5,A10,3F6.2)end program learn

文件定位

• rewind 从文件头开始

 请输入文件名:
test.dat请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
1,张三,87.34,69.49,73.29录入成功！继续录入吗？(y/n)
y请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
2,李四,88.32,76.33,93.16录入成功！继续录入吗？(y/n)
n请输入学号:
11张三       87.34 69.49 73.29请输入学号:
22李四       88.32 76.33 93.16请输入学号:
11张三       87.34 69.49 73.29请输入学号:
11张三       87.34 69.49 73.29请输入学号:
22李四       88.32 76.33 93.16请输入学号:
22李四       88.32 76.33 93.16请输入学号:
3找不到该学生的记录请输入学号:
11张三       87.34 69.49 73.29请输入学号:
22李四       88.32 76.33 93.16请输入学号:
3找不到该学生的记录请输入学号:
99找不到该学生的记录请输入学号:
-1

program learnimplicit nonecharacter(10)::student_namecharacter(20)::file_namecharacter(1)::is_continue_input,anslogical::data_is_findedinteger::idinteger::io_statusinteger::read_statusinteger::write_statusinteger::search_idcharacter(100)::err_msgreal::math_score,english_score,politics_scorewrite(*,*) "请输入文件名:"read (*,*)  file_nameopen (unit=11,file=file_name,status='replace',action='write',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "写入文件",file_name,"异常:",err_msgelsewrite_file:dowrite(*,*) "请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):"read (*,*,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0) cyclewrite(11,100,iostat=write_status) id,student_name,math_score,english_score,politics_scoreif (write_status==0) write (*,*) "录入成功！"write (*,*) "继续录入吗？(y/n)"read(*,*) is_continue_inputif (is_continue_input=='n' .or. is_continue_input=='N') exitend do write_fileclose(unit=11)endifopen (unit=10,file=file_name,status='old',action='read',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "读取文件",file_name,"异常:",err_msgelsesearch_data:dodata_is_finded=.false.write(*,*) "请输入学号:"read(*,*) search_idif (search_id<=0) exitrewind(unit=10) !从文件头开始find_id:doread (10,100,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0) exitif (id==search_id) thendata_is_finded=.true.write (*,100) id,student_name,math_score,english_score,politics_scoreendifend do find_idif (.not. data_is_finded) write(*,*) "找不到该学生的记录"end do search_dataclose(unit=10)endif100 format(I5,A10,3F6.2)end program learn

• backspace 回退一条记录

请输入文件名:
test.dat请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
1,张三,66,77,88录入成功！继续录入吗？(y/n)
y请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
2,李四,88,99,77录入成功！继续录入吗？(y/n)
y请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):
3,王五,72,83,91录入成功！继续录入吗？(y/n)
n1张三       66.00 77.00 88.002李四       88.00 99.00 77.003王五       72.00 83.00 91.003王五       72.00 83.00 91.002李四       88.00 99.00 77.001张三       66.00 77.00 88.00Process returned 0 (0x0)   execution time : 40.113 s
Press any key to continue.

program learnimplicit nonecharacter(10)::student_namecharacter(20)::file_namecharacter(1)::is_continue_inputinteger::record_countinteger::idinteger::io_statusinteger::read_statusinteger::write_statuscharacter(100)::err_msgreal::math_score,english_score,politics_scorerecord_count=0write(*,*) "请输入文件名:"read (*,*)  file_nameopen (unit=11,file=file_name,status='replace',action='write',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "写入文件",file_name,"异常:",err_msgelsewrite_file:dowrite(*,*) "请输入数据（学号,姓名,数学成绩,英语成绩,政治成绩):"read (*,*,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0) cyclewrite(11,100,iostat=write_status) id,student_name,math_score,english_score,politics_scoreif (write_status==0) write (*,*) "录入成功！"write (*,*) "继续录入吗？(y/n)"read(*,*) is_continue_inputif (is_continue_input=='n' .or. is_continue_input=='N') exitend do write_fileclose(unit=11)endifopen (unit=10,file=file_name,status='old',action='read',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,*) "读取文件",file_name,"异常:",err_msgelseread_file:doread (10,100,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0) exitwrite (*,100) id,student_name,math_score,english_score,politics_scorerecord_count=record_count+1end do read_filebackspace(unit=10)back_read_file:dobackspace(unit=10)read (10,100,iostat=read_status) id,student_name,math_score,english_score,politics_scoreif (read_status/=0  .or. record_count<=0) exitwrite (*,100) id,student_name,math_score,english_score,politics_scorebackspace(unit=10)record_count=record_count-1end do back_read_fileclose(unit=10)endif100 format(I5,A10,3F6.2)end program learn

csv

下载鸢尾属植物机器学习数据集
http://archive.ics.uci.edu/dataset/53/iris
数据集包含3类，每个类包含50个实例，每个类表示一种鸢尾属植物。一类与另一类是线性可分离的；后者彼此之间不是线性可分离的。

program learnimplicit nonecharacter(20)::class_namecharacter(200)::file_nameinteger::record_count=0integer::io_statusinteger::read_statusinteger::path_poscharacter(200)::err_msgreal::sepal_length,sepal_width,petal_length,petal_widthcharacter(len=255) :: cmdcall get_command(cmd)path_pos=index(cmd, '\' , .true.)file_name=trim(cmd(1:path_pos))//"iris\iris.data"open (unit=10,file=file_name,status='old',action='read',iostat=io_status,iomsg=err_msg)if (io_status/=0)  thenwrite(*,90) file_name,err_msg90 format ('读取iris文件',A200,'异常:',A200)elsewrite (*,*) "萼片长度,萼片宽度,花瓣长度,花瓣宽度,分类"read_file:doread (10,*,iostat=read_status) sepal_length,sepal_width,petal_length,petal_width,class_nameif (read_status/=0) exitwrite (*,100) sepal_length,sepal_width,petal_length,petal_width,class_namerecord_count=record_count+1end do read_fileclose(unit=10)write (*,*) "共读取",record_count,"条数据!"endif100 format(4(F5.1,1X),A50)end program learn

...
...6.7   3.0   5.2   2.3                               Iris-virginica6.3   2.5   5.0   1.9                               Iris-virginica6.5   3.0   5.2   2.0                               Iris-virginica6.2   3.4   5.4   2.3                               Iris-virginica5.9   3.0   5.1   1.8                               Iris-virginica共读取         150 条数据!

数组

一维数组

program helloimplicit noneinteger,dimension(5)::x=[1,2,3,4,5]integer,dimension(5)::b=[11,22,33,44,55]real::a=6.2real,dimension(5)::yy=x*a+bwrite(*,*) y
end program

   17.2000008       34.4000015       51.5999985       68.8000031       86.0000000Process returned 0 (0x0)   execution time : 0.032 s
Press any key to continue.

最小二乘法

program helloimplicit nonereal,dimension(5)::x=[10,20,30,40,50]real,dimension(5)::b=[10,15,12,13,9]real::a=16.29real,dimension(5)::yreal::x_meanreal::y_meanreal::a_predict2real::a_predict1real::b_predict,a_predicty=a*x+bx_mean=sum(x)/5y_mean=sum(y)/5a_predict2=sum((x-x_mean)**2)a_predict1=sum(((x-x_mean)*(y-y_mean)))a_predict=a_predict1/a_predict2b_predict=y_mean-a*x_meanwrite(*,*) 'a=',a_predictwrite(*,*) 'b=',b_predict
end program

下标

program learnimplicit nonereal,dimension(5)::a=[10,20,30,40,50]integer,dimension(5)::b=[1,2,3,4,5]integer::iwrite (*,*) [(i,i=1,3)]write (*,*) (i,i=3,20,4)write(*,*) a(2:4)write(*,*) b(1),b(4)write(*,*) b([1,5])write(*,*) b([(i,i=1,5,2)])end program learn

           1           2           33           7          11          15          1920.0000000       30.0000000       40.00000001           41           51           3           5Process returned 0 (0x0)   execution time : 0.034 s
Press any key to continue.

隐式循环

program learnimplicit noneinteger i,jwrite (*,100) ((i,j,j=1,9),i=1,9)100 format (I5,1X,I5)write (*,110) ((i,j,i*j,j=1,9),i=1,9)110 format (I5,'*',I5,'=',I10)end program learn

...9     49     59     69     79     89     91*    1=         11*    2=         21*    3=         31*    4=         41*    5=         51*    6=         61*    7=         71*    8=         8...

	program learnimplicit noneinteger,dimension(2,3)::ainteger,dimension(2,3)::ba=reshape([1,66,89,2,74,79],[2,3])b=reshape([1,76,99,2,84,59],[2,3])write (*,100) awrite (*,100) b100 format (3I5)end program learn

    1   66   892   74   791   76   992   84   59Process returned 0 (0x0)   execution time : 0.172 s
Press any key to continue.

关系代数基本运算

笛卡尔积

aid a1 a2bid b1 b21 66 74  1 76 842 89 79  1 76 841 66 74  2 99 592 89 79  2 99 59Process returned 0 (0x0)   execution time : 0.167 s
Press any key to continue.

program learnimplicit noneinteger,dimension(2,3)::ainteger,dimension(2,3)::binteger::i,ja=reshape([1,2,66,89,74,79],[2,3])b=reshape([1,2,76,99,84,59],[2,3])write (*,120) 'aid','a1','a2','bid','b1','b2'write (*,110) ((a(i,:),b(j,:),i=1,2),j=1,2)110 format (6(I3))120 format (6(A3))
end program learn

aid a1 a2bid b1 b21 66 74  1 76 842 89 79  1 76 841 66 74  2 99 592 89 79  2 99 59---------2 89 79  1 76 84---------66 89 66 89

program learnimplicit noneinteger,dimension(2,3)::ainteger,dimension(2,3)::binteger,dimension(24)::cinteger,dimension(4,6)::dinteger::i,jinteger::ka=reshape([1,2,66,89,74,79],[2,3],order=[1,2])b=reshape([1,2,76,99,84,59],[2,3],order=[1,2])write (*,120) 'aid','a1','a2','bid','b1','b2'c=[((a(i,:),b(j,:),i=1,2),j=1,2)]d=reshape(c,[4,6],order=[2,1])write (*,110) cwrite  (*,*) "---------"write (*,110) d(2,:)write  (*,*) "---------"write (*,110) d(:,2)110 format (6(I3))120 format (6(A3))
end program learn

投影+选择

program learnimplicit noneinteger,dimension(2,3)::ainteger,dimension(2,3)::binteger,dimension(24)::cinteger,dimension(4,6)::dinteger::i,jinteger::ka=reshape([1,2,66,89,74,79],[2,3],order=[1,2])b=reshape([1,2,76,99,84,59],[2,3],order=[1,2])write (*,120) 'aid','a1','a2','bid','b1','b2'c=[((a(i,:),b(j,:),i=1,2),j=1,2)]d=reshape(c,[4,6],order=[2,1])write (*,110) cwrite  (*,*) "---------"write (*,110) d(2,:)write  (*,*) "---------"write (*,110) d(:,2)write  (*,*) "---------"write  (*,*) "b1>70 and a2<70"write (*,120) 'aid','a1','a2','bid','b1','b2'!b1>70 and a2<90 选择k=1doif (d(k,5)>70 .and. d(k,3)<79) write (*,110) d(k,:)k=k+1if (k>4) exitend dowrite (*,120) 'aid','a1','a2','bid','b1','b2'!b1>70 and a2<90 选择+投影write  (*,*) "b1>70 and a2<70 and aid=bid"write (*,120) 'aid','a1','a2','b1','b2'k=1doif (d(k,5)>70 .and. d(k,3)<79 .and. d(k,1)==d(k,4)) write (*,110) d(k,1:3),d(k,5:6)k=k+1if (k>4) exitend do110 format (6(I3))120 format (6(A3))
end program learn

aid a1 a2bid b1 b21 66 74  1 76 842 89 79  1 76 841 66 74  2 99 592 89 79  2 99 59---------2 89 79  1 76 84---------66 89 66 89---------b1>70 and a2<70
aid a1 a2bid b1 b21 66 74  1 76 841 66 74  2 99 59
aid a1 a2bid b1 b2b1>70 and a2<70 and aid=bid
aid a1 a2 b1 b21 66 74 76 84Process returned 0 (0x0)   execution time : 0.141 s
Press any key to continue.

过程参数

program helloimplicit noneinteger,dimension(10)::my_numsinteger::result,avg,imy_nums=[(i,i=1,40,4 )]call sum_nums(my_nums,10,result,avg)write(*,*) result,avgend programsubroutine sum_nums(nums,n,result,avg)integer,dimension(n),intent(in):: numsinteger,intent(out)::result,avgresult=0do i=1,nwrite (*,*) nums(i)result=result+nums(i)end doavg=result/n
end subroutine

select case 和 过程

 请输入计算的类型:1-->三角形           2-->平行四边形     3-->梯形              4-->圆形              
1请输入计算的参数1
9.22请输入计算的参数2
2.7请输入计算的参数3
-1
三角形            面积：     12.45Process returned 0 (0x0)   execution time : 10.916 s
Press ENTER to continue.

program helloimplicit noneinteger::g_type,ireal::preal::areacharacter(len=20),dimension(4)::g_strreal,dimension(3)::paramg_str=[character(len=20)::"三角形","平行四边形","梯形","圆形"]write (*,*) "请输入计算的类型:"write (*,110) (i,g_str(i),i=1,4)110 format (I3,'-->',A20)read (*,"(I3)") g_typeif (g_type>4 .or. g_type<1) stopi=1do while (i<4)write (*,"(A30,I1)") "请输入计算的参数",iread (*,"(F6.2)") pif (p>=0.) thenparam(i)=pelseexitend ifi=i+1end docall get_area(param,area,g_type)write (*,"(A20,A10,F10.2)") g_str(g_type),"面积：",area
end programsubroutine get_area(param,area,g_type)integer,intent(in):: g_typereal,dimension(3),intent(in)::paramreal,intent(out):: areaselect case (g_type)case(1)area=(1/2.)*param(1)*param(2)case(2)area=param(1)*param(2)case(3)area=(1/2.)*(param(1)+param(2))*param(3)case(4)area=2.*3.1415*param(1)end select
end subroutine get_area

module

 请输入计算的类型:1-->平均速度(x1,x2,t1,t2)2-->平均速率(s,t1,t2)
2请输入s,t1,t2:
38,11,1210.345454544Process returned 0 (0x0)   execution time : 10.317 s
Press any key to continue.

program learnuse v_computeimplicit nonereal::t1,t2,x1,x2,s,resultinteger::cpt_type,icharacter(len=40),dimension(2)::cpt_strcpt_str=[character(len=40)::"平均速度(x1,x2,t1,t2)","平均速率(s,t1,t2)"]write (*,*) "请输入计算的类型:"write (*,110) (i,cpt_str(i),i=1,2)110 format (I3,'-->',A40)read (*,"(I3)") cpt_typeif (cpt_type>2 .or. cpt_type<1) stopselect case(cpt_type)case(1)write (*,*) "请输入x1,x2,t1,t2:"read (*,*) x1,x2,t1,t2call get_v(x1,x2,t1,t2,result)case(2)write (*,*) "请输入s,t1,t2:"read (*,*) s,t1,t2call get_v(s,t1,t2,result)end selectwrite (*,*) result
end program learn

v_compute.f90

module v_compute
implicit noneinterface get_vmodule procedure get_v1module procedure get_v2end interface
containssubroutine get_v1(x1,x2,t1,t2,result)!平均速度real,intent(out)::resultreal,intent(out)::x1,x2,t1,t2result=(x2-x1)/(t2-t1)end subroutinesubroutine get_v2(s,t1,t2,result)!平均速率real,intent(out)::resultreal,intent(out)::s,t1,t2result=s/(t2-t1)end subroutineend module v_compute

快排

  489223334568891
212Process returned 0 (0x0)   execution time : 0.139 s
Press any key to continue.

program helloimplicit noneinteger,dimension(10)::my_numsinteger::imy_nums=[9,34,212,91,88,33,8,22,4,56]call qsort_nums(my_nums,1,10)write(*,"(I3)") [(my_nums(i),i=1,10)]end programrecursive subroutine qsort_nums(nums,first,last)integer,intent(in)::first,lastinteger,dimension(n),intent(inout):: numsinteger::i,j,key,tempif (last<=first) thenreturnend ifi=firstj=lastkey=nums(first)sort:doi_next:doif (nums(i)<=key .and. i<last) theni=i+1elseexitendifend do i_nextj_prev:doif (nums(j)>key .and. j>first) thenj=j-1elseexitendifend do j_previf (i<j) thentemp=nums(i)nums(i)=nums(j)nums(j)=tempelseexit sortend ifend do sortnums(first)= nums(j);nums(j) = key;call qsort_nums(nums,first,j-1)call qsort_nums(nums,j+1,last)
end subroutine

函数

• 内部函数

program learnimplicit nonereal::result,xx=11.33result=get_num(x)write (*,100) x,result100 format (2F10.2)containsreal function get_num(x)real,intent(in)::xget_num=x*2end function get_num
end program learn

• 外部函数

program learnimplicit nonereal::get_numreal::result,xx=11.33result=get_num(x)write (*,100) x,result100 format (2F10.2)
end program learnreal function get_num(x)real,intent(in)::xget_num=x*2
end function get_num

• 二分法求解一元多次方程
  main.f90

program hellouse bisectimplicit nonereal::rootinteger::err_flagcharacter(len=50)::err_msgreal,external::fun_rootcall get_root(fun_root,-20.,20.,1.0E-7,root,err_flag,err_msg)if (err_flag>0) thenwrite (*,*) "error:",err_msgelsewrite (*,*) rootend ifend programreal function fun_root(x)implicit nonereal,intent(in)::xfun_root=5*x**3-3*x**2+111*x+21
end function fun_root

bisect.f90

module bisect
implicit nonecontainssubroutine get_root(func,x_a,x_b,tolerance,root,err_flag,err_msg)integer,intent(out)::err_flagcharacter(len=50),intent(out)::err_msgreal,external::funcreal,intent(out)::rootreal,intent(in)::x_a,x_b,tolerancereal::areal::breal::fun_a,fun_b,fun_x,xa=x_ab=x_bfun_a=func(a)fun_b=func(b)if (fun_a*fun_b>=0) thenerr_flag=1err_msg="f(a)f(b)>0"returnend ifwrite (*,"(A1)",advance='no') "|"do while ((b-a)/2>tolerance)x=(a+b)/2fun_x=func(x)if (fun_x==0.) thenexitendifif (fun_x*fun_a<0.) thenb=xfun_b=fun_xelsea=xfun_a=fun_xend ifwrite (*,"(A1)",advance='no') "="end dowrite (*,"(A1/)",advance='no') ">"root=(a+b)/2err_flag=0err_msg=""end subroutineend module bisect

|============================>-0.187935606Process returned 0 (0x0)   execution time : 0.033 s
Press any key to continue.

• 正割法

|=============================>-1.31523108
.. 找到解-1.31523120Process returned 0 (0x0)   execution time : 0.149 s
Press any key to continue.

program hellouse equation_rootimplicit nonereal::rootreal::a,binteger::err_flagcharacter(len=50)::err_msgreal,external::fun_roota=-50.b=50.call get_root(2,fun_root,a,b,1.0E-7,1.0E-35,root,err_flag,err_msg,50)if (err_flag>0) thenwrite (*,*) "error:",err_msgelsewrite (*,*) rootend ifend programreal function fun_root(x)implicit nonereal,intent(in)::xfun_root=x**3+9*cos(x)
end function fun_root

自定义类型

program learnimplicit nonetype::studentinteger::student_idcharacter(len=10)::student_nameinteger::ageinteger::class_idend typetype::classinteger::class_idcharacter(len=50)::class_nameinteger::teacher_id!班主任IDend typetype::student_scorereal::english_scorereal::math_scorereal::fortran_scorereal::cpp_scorereal::data_struct_scorereal::politics_scorereal::database_scoreend typetype::teacherinteger::teacher_idcharacter(len=10)::teacher_namecharacter(len=50)::degree!学位end typetype(student) ::st1=student(1,"张三",25,1)write(*,*) st1%student_id,st1%student_name,st1%age,st1%class_idend program learn

           1 张三                25           1Process returned 0 (0x0)   execution time : 0.167 s
Press any key to continue.