应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

Znn3bq.jpeg
小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 如何从高斯输出文件快速提出 pai 轨道信息。
51/1返回列表
查看: 1643  |  回复: 7
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
本帖产生 1 个 程序强帖 ，点击这里进行查看
当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

kathy2008

木虫 (正式写手)

[求助] 如何从高斯输出文件快速提出 pai 轨道信息。

如题。从高斯输出文件提出了eigenvector那一部分出来，即附件1。现在需要得到 pai 轨道信息。即附件2。 附件2 对应于附件1的32号，35号，38号，39号，40号，41号轨道（占据轨道），42号一直到47号（非占据轨道）的2Px值。求一小程序。请指点。谢谢。
回复此楼

» 猜你喜欢

» 本主题相关价值贴推荐，对您同样有帮助:
1楼 2011-06-17 19:54:10
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★
dubo(金币+1): 欢迎常来程序语言版讨论 2011-07-31 13:36:35
这样可能更好一些：
CODE:
      program ei
      implicit none
      real, dimension(:,:), allocatable :: px,ppx
      character(len=256) :: line
      character(len=40) :: fm
      integer :: nrow, ncol, i, j, k, ios, n, m
      
      open(unit=12, file='nc3h7-r2-sto-eiv.out', status='old')
      open(unit=13, file='nc3h7-r2-sto-pai.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, '2PZ') /= 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, '2PZ') /= 0) then
             line = line(21:)
!            write(*,*) trim(line)
             i=i+1
             n = len_trim(line)/10
             m = mod(len_trim(line),10)
!            write (*,*) m, n
             if (m /= 0) then
                write(fm,'(a,i0,a,i0,a)') '(tr',m,',',n,'f10.5)'
             else
                write(fm,'(a,i0,a)') '(',n,'f10.5)'
             end if
!            write (*,*) fm
!            write(*,*) j
             read(line,fm) ppx(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
赞一下(1人) 回复此楼
5楼2011-07-03 22:59:20
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 8 个回答

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人) 回复此楼
2楼2011-06-18 16:41:08
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

kathy2008

木虫 (正式写手)
★
dubo(金币+1): 欢迎常来程序语言版讨论 2011-07-31 13:36:05
引用回帖:
Originally posted by snoopyzhao at 2011-06-18 16:41:08:
大概这个样子。只是需要手工输入轨道号（这样可能灵活一些），每次输入一个轨道序号，回车，输入 0 则结束整个程序……

[code]
program ei
real, dimension(:,, allocatable :: px,ppx
character(len=256 ...

利用该程序提取π轨道信息，报错。信息如下
At line 48 of file eigen-pai-nc3h7-r2.f
Fortran runtime error: Bad value during floating point read

google也没有找到应对之策，请高手指点。
赞一下(1人) 回复此楼
3楼2011-07-03 15:06:57
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★
dubo(金币+1): 欢迎常来程序语言版讨论 2011-07-31 13:36:26
你的 .out 文件是咋生成的，这次的这个文件比上次的文件每一行前面多了一个空格……

所以，你把程序中：
CODE:
line = line(21:)

改成
CODE:
line = line(22:)

就可以了……
赞一下(1人) 回复此楼
4楼2011-07-03 22:28:17
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 8 个回答
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 调剂 +6 青灯不负 2026-04-09 6/300 2026-04-11 20:35 by dongdian1
[考研] 271求调剂 +21 2261744733 2026-04-11 21/1050 2026-04-11 20:19 by Angchemist
[考研] 0854求调剂 +7 assdll 2026-04-05 7/350 2026-04-11 10:34 by Delta2012
[考研] 生物学调剂 +8 小冉要努力 2026-04-10 9/450 2026-04-11 10:22 by wwj2530616
[考研] 0831生医工第一轮调剂失败求助 +10 小熊睿睿_s 2026-04-11 13/650 2026-04-11 10:04 by maddjdld
[考研] 中科院总分315求调剂 +8 lallalh 2026-04-09 8/400 2026-04-10 19:30 by dick_runner
[考研] 284求调剂 +9 让我上岸吧阿西 2026-04-09 11/550 2026-04-10 19:18 by 靖jing
[考研] 08工学 309分求调剂 +6 Yin DY 2026-04-08 6/300 2026-04-10 09:18 by Delta2012
[考研] 0703化学求调剂 +21 不知名的小卅 2026-04-08 21/1050 2026-04-09 18:55 by l_paradox
[考研] 本科郑州大学，一志愿华东师范大学282求调剂 +23 熊哥xtk 2026-04-07 26/1300 2026-04-09 17:17 by 18446523
[考研] 生物学308分求调剂（一志愿华东师大） +13 相信必会光芒万� 2026-04-06 16/800 2026-04-09 13:54 by 徐良白眉大侠
[考研] 材料调剂 +14 一样YWY 2026-04-05 15/750 2026-04-09 13:36 by 故人??
[考研] 286求调剂 +19 Faune 2026-04-08 20/1000 2026-04-09 08:36 by 哦哦123
[考研] 327求调剂 +10 Xxjc1107. 2026-04-06 11/550 2026-04-09 01:21 by lature00
[考研] 专硕085403，291分，有两篇专利，一国一奖 +3 哈吉咪哈吉咪 2026-04-07 3/150 2026-04-07 18:21 by 蓝云思雨
[考研] 22408 调剂材料 +7 我叫ez 2026-04-06 8/400 2026-04-07 17:12 by 蓝云思雨
[考研] 材料调剂 +11 一样YWY 2026-04-07 11/550 2026-04-07 15:13 by shdgaomin
[考研] 信工所11408 340分 本科西安交大自动化 +3 moontrek 2026-04-06 3/150 2026-04-07 09:56 by chongya
[考研] 338求调剂 +4 我想上岸ii 2026-04-05 4/200 2026-04-06 21:04 by 木子君1218
[考研] 08专硕275调剂 +5 AaAa7420 2026-04-05 5/250 2026-04-05 18:01 by jkddd
信息提示
关闭
请填处理意见
关闭