最近又開始回鍋寫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