最近又開始回鍋寫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 -- https://i.imgur.com/h4Q0F04.jpg 9月23日 發生大事了 因為就在這天，加藤惠誕生了 https://i.imgur.com/H3RhXfJ.jpg --

※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 223.139.189.144 (臺灣) ※ 文章網址: https://webptt.com/m.aspx?n=bbs/Fortran/M.1669448975.A.3A1.html