24小时热门版块排行榜    

Znn3bq.jpeg
查看: 1661  |  回复: 7
本帖产生 1 个 程序强帖 ,点击这里进行查看
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
ben_ladeng(金币+2): 很详细,待楼主评定后奖励程序强帖 2011-06-18 17:42:21
kathy2008(金币+10): 2011-06-19 13:00:43
微尘、梦想(程序强帖+1): 2011-06-19 17:04:28
大概这个样子。只是需要手工输入轨道号(这样可能灵活一些),每次输入一个轨道序号,回车,输入 0 则结束整个程序……
CODE:
program ei
real, dimension(:,:), allocatable :: px,ppx
character(len=256) :: line
character(len=40) :: fm
integer :: nrow, ncol, i, j, k, ios

open(unit=12, file='eigenvector.out', status='old')
open(unit=13, file='2px.out', status='new')

do
   read(12,'(a)', iostat=ios) line
   if (ios /= 0) exit
   if (index(line,'EIGENVALUES') /= 0) then
      nrow=0
      ncol=0
      do
         read(12,'(a)', iostat=ios) line
         if (ios /= 0) exit
         if (line(1:4) == '    ') exit
         ncol=ncol+1
         if (index(line, '2PX') /= 0) nrow=nrow+1
      end do
      exit
   end if
end do

!write (*,*) nrow, ncol
rewind (12)

allocate(px(nrow,ncol),ppx(nrow,ncol))

i=0
j=0
do
   read(12,'(a)', iostat=ios) line
   if (ios /= 0) exit
   if (i == nrow) then
       i=0
       j=j+n
   end if
   if (index(line, '2PX') /= 0) then
       line = line(21:)
!      write(*,*) trim(line)
       i=i+1
       n = len_trim(line)/10
       write(fm,'(a,i0,a)') '(', n, 'f10.5)'
!      write(*,*) j
       read(line,fm) px(i,(j+1):(j+n))
   end if
end do

k=0
do
   write(*,*) 'please input a number between 1 and ', nrow, 'end the program by 0.'
   read(*,*) i
   if(i==0) exit
   k=k+1
   ppx(:,k) = px(:,i)
end do

!write(*,*) k/5, mod(k,5)

if (k>=5) then
   do j=1,k/5
      do i=1,nrow
         write(13,'(5f10.5)') ppx(i,(j-1)*5+1:j*5)
      end do
      write(13,*)
   end do
end if
if (mod(k,5) /=0) then
   write(fm,'(a,i0,a)') '(', mod(k,5), 'f10.5)'
   do i=1,nrow
      write(13, fm) ppx(i,(k/5*5+1):k)
   end do
end if

end program ei

2楼2011-06-18 16:41:08
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

智能机器人

Robot (super robot)

我们都爱小木虫

相关版块跳转 我要订阅楼主 kathy2008 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考博] 申博/考博 +4 啃面包的小书虫 2026-04-17 8/400 2026-04-21 16:26 by 啃面包的小书虫
[考研] 一志愿A区211,22408 321求调剂 +7 随心所欲☆ 2026-04-15 8/400 2026-04-21 08:22 by Equinoxhua
[考研] 295分求调剂 +6 ?要上岸? 2026-04-17 6/300 2026-04-21 08:18 by Equinoxhua
[考研] 一志愿中科大材料与化工,353分还有调剂学校吗 +11 否极泰来2026 2026-04-15 13/650 2026-04-20 22:31 by Equinoxhua
[考研] 085600材料与化工调剂 5+3 孜孜不倦2002 2026-04-19 6/300 2026-04-20 21:25 by babero
[论文投稿] 期刊推荐 +3 材料研究生 2026-04-15 5/250 2026-04-20 16:02 by 豆豆7758
[论文投稿] 有没有接收比较快的sci期刊呀,最好在一个月之内的,研三孩子求毕业 20+4 之护着 2026-04-16 7/350 2026-04-20 15:45 by 豆豆7758
[考博] 申博 +3 Xyyx. 2026-04-18 3/150 2026-04-20 10:44 by YuY66
[考博] 湖南大学刘巧玲课题组2026年第二批次博士研究生招生信息 +3 南风观火 2026-04-18 5/250 2026-04-20 10:13 by 南风观火
[考研] 求计算机方向调剂 +3 Toffee2 2026-04-16 6/300 2026-04-19 22:37 by ll叶
[考研] 294求调剂 +8 淡然654321 2026-04-17 9/450 2026-04-19 19:51 by Equinoxhua
[考研] 304求调剂 +8 castLight 2026-04-16 8/400 2026-04-19 17:14 by 中豫男
[考研] 求调剂 +10 小聂爱学习 2026-04-16 12/600 2026-04-19 16:51 by 中豫男
[考研] 求调剂 +6 苦命人。。。 2026-04-18 7/350 2026-04-19 16:27 by 中豫男
[考研] 294求调剂 +15 淡然654321 2026-04-15 15/750 2026-04-19 08:20 by cuisz
[考研] 0854求调剂 +23 门路摸摸 2026-04-15 27/1350 2026-04-19 01:59 by 烟雨流涯
[考研] 300求调剂 +12 橙a777 2026-04-15 12/600 2026-04-18 23:51 by 路病情
[考研] 接受任何调剂 +6 也就是栗子 2026-04-17 7/350 2026-04-18 17:20 by 涵竹刘
[有机交流] 二苯甲酮酸类衍生物 50+3 小白爱主人 2026-04-17 6/300 2026-04-17 18:47 by kf2781974
[考研] 322求调剂 +6 tekuzu 2026-04-17 6/300 2026-04-17 13:48 by Espannnnnol
信息提示
请填处理意见