最近又开始回锅写fortran了，总觉得该偶尔产点文章回馈板上免得哪天废板了
(今年快结束了这还只是板上本年度第四篇吗!?)
这次带来的是部分自写，在快排部分则使用板上前面几篇提到的副程式的程式
文章:[问题] 这支快速排序法的副程式怎么使用
如果是vscode的使用者，生成执行档(exe)后可以直接拿来给别人用
废话讲满久的了，以下正文
其实这个程式我主要是下苦工在读档方面
只要在双精度以下的浮点数，并且档案内容为完整的m*n矩阵就能执行排序
(阵列内东缺西缺的话麻烦自己补值)
借由write的第一格其实除了能塞代号外还能塞文字变量来改写的功能
来实现自动侦测浮点数格式的功能
并且借由write第二格也能使用文字变量的功能来实现使用被读取档格式的功能
(不过还是有一些地方怪怪的，吃进来的数据还是会和原数据在最后面有点不一样)
然后如果想测试又懒得写测试档，我会在下面一并附上
测试档会产生三个档案:rand1.txt rand2.txt rand3.txt
照着程式运作时的说明输入档案名来测试就行了
有进一步改写的需求的人，以下是建议:
1.主程式的real*8，副程式的real*8都要一致
2.第二个容易产生错误的地方是把格式写入forma这个变量的时候写入的格式不对
(以上都是来自我自己在real和real*8间进行转换时遇到错误的经验)
另外，格式f08.05能带来与f8.5一样的格式化输出
所以这个程式对单精度的数据一样能成立
program main
implicit none
character(len=50) :: fname
character(len=10) :: forma
character(len=1) :: digi
character(len=1) :: choice
integer :: raws,cols,stat,total,i,j,space,decimal,digits,number
real*8 :: r
real*8,allocatable :: arr(:)
data forma /'(f??.??)'/
100 write(*,*) "please enter the file name(including file type) for sorting."
read(*,*) fname
raws=0
open(13,file = fname,status='unknown')
do while(.true.)
read(13,*,iostat=stat)
if(stat.ne.0) exit
raws = raws + 1
end do
rewind(13)
! read data format, by space, decimal, digits respectly
! space
space = 0
do while(.true.)
read(13,'(a1)',advance='no') digi
if(digi.ne.' ') exit
space = space + 1
end do
write(*,*) "space=",space
! decimal
decimal = space + 1
do while(.true.)
read(13,'(a1)',advance='no') digi
decimal = decimal + 1
if(digi.eq.'.') exit
end do
write(*,*) "decimal=",decimal
! digits
digits = decimal
do while(.true.)
read(13,'(a1)',advance='no',iostat=stat) digi
if(stat.ne.0) exit
if(digi.eq.' ') exit
digits = digits + 1
end do
write(*,*) "digits=",digits
rewind(13)
write(forma(3:4),'(i2)') digits
write(forma(6:7),'(i2)') digits - decimal
write(*,*) "data format: ",forma
read(13,forma) r
write(*,*) "first data =",r
rewind(13)
cols=0
do while(.true.)
read(13,forma,advance='no',iostat=stat) r
if(stat.ne.0) exit
cols = cols + 1
end do
rewind(13)
cols = cols
total=cols*raws
write(*,*) "This file have",total,"data"
write(*,*) "2D-data array =",cols,"x",raws
write(*,*) "Initiating quick sort"
allocate(arr(total))
! x data in one line means one line have x + 1 words
number = 0
cols = cols + 1
do i = 1,raws
do j = 1,cols
read(13,forma,advance='no',iostat=stat) r
if(stat.ne.0) cycle
number = number + 1
arr(number) = r
end do
end do
close(13)
call quicksort(arr,1,total)
write(*,*) "Sorting complete, write the result in txtfile(y) or show the
result on board(other). "
read(*,*) choice
if(choice.eq.'y')then
write(*,*) "Please enter the filename(including file type)."
read(*,*) fname
open(14,file = fname,status='unknown')
do i = 1,total
write(14,*) arr(i)
end do
else
do i = 1,total
write(*,*) arr(i)
end do
end if
close(14)
deallocate(arr)
write(*,*) "Press (c) to continue, press other key to end the program."
read(*,*) choice
if(choice.eq.'c') goto 100
stop
end program
recursive subroutine quicksort(a, first, last)
implicit none
real*8 a(*), x, t
integer first, last
integer i, j
x = a( (first+last) / 2 )
i = first
j = last
do while(.true.)
do while (a(i) < x)
i=i+1
end do
do while (x < a(j))
j=j-1
end do
if (i >= j) exit
t = a(i); a(i) = a(j); a(j) = t
i=i+1
j=j-1
end do
if (first < i-1) call quicksort(a, first, i-1)
if (j+1 < last) call quicksort(a, j+1, last)
end subroutine quicksort
以下是测试生成档
program main
implicit none
real :: r(30)
real*8 :: rr(40)
integer :: i,j,total
call random_seed()
total = 0
call random_number(r)
open(13,file='rand1.txt',status='unknown')
do i = 1,3
do j = 1,10
total = total + 1
write(13,'(f14.8)',advance='no') r(total)
end do
write(13,*) ""
end do
close(13)
call random_number(r)
open(14,file='rand2.txt',status='unknown')
do i = 1,30
write(14,'(f13.8)') r(i)*100
end do
close(14)
total = 0
call random_number(rr)
open(15,file='rand3.txt',status='unknown')
do i = 1,8
do j = 1,5
total = total + 1
write(15,'(f17.14)') rr(total)
end do
end do
stop
end program main