最近又开始回锅写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/cn.aspx?n=bbs/Fortran/M.1669448975.A.3A1.html