24小时热门版块排行榜    

查看: 1769  |  回复: 7
本帖产生 1 个 程序强帖 ,点击这里进行查看

kathy2008

木虫 (正式写手)

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

如题。从高斯输出文件提出了eigenvector那一部分出来,即附件1。现在需要得到 pai 轨道信息。即附件2。 附件2 对应于附件1的32号,35号,38号,39号,40号,41号轨道(占据轨道),42号一直到47号(非占据轨道)的2Px值。求一小程序。请指点。谢谢。
回复此楼
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

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的回帖

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也没有找到应对之策,请高手指点。
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:)

就可以了……
4楼2011-07-03 22:28:17
已阅   回复此楼   关注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

5楼2011-07-03 22:59:20
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

kathy2008

木虫 (正式写手)


dubo(金币+1): 欢迎常来程序语言版讨论 2011-07-31 13:36:56
引用回帖:
Originally posted by snoopyzhao at 2011-07-03 22:28:17:
你的 .out 文件是咋生成的,这次的这个文件比上次的文件每一行前面多了一个空格……

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

改成
CODE:
line = line(22:)

就可以了……

运行后报错信息如下:
*** glibc detected *** ./a.out: double free or corruption (out): 0x00000000079e2980 ***
======= Backtrace: =========
/lib64/libc.so.6[0x3e64871ce2]
/lib64/libc.so.6(cfree+0x8c)[0x3e6487590c]
./a.out[0x4012c5]
./a.out[0x4019de]
/lib64/libc.so.6(__libc_start_main+0xf4)[0x3e6481d974]
./a.out[0x400a99]
6楼2011-07-04 07:23:29
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)


jjdg(金币+1): 感谢参与 2011-07-04 12:46:36
我才注意到,你把我在二楼给出的程序中的
CODE:
read(line,fm) px(i,(j+1):(j+n))

改成了
CODE:
read(line,fm) ppx(i,(j+1):(j+n))

害得我弄了半天才知道为啥出来的结果总是不对。
7楼2011-07-04 09:48:55
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

★ ★
jjdg(金币+2): 辛苦了 2011-07-04 12:46:22
另外,原程序中
CODE:
write(*,*) 'please input a number between 1 and ', nrow, 'end the program by 0.'

应该改为
CODE:
write(*,*) 'please input a number between 1 and ', ncol, 'end the program by 0.'

8楼2011-07-04 09:50:20
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 kathy2008 的主题更新
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[硕博家园] 售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急 +3 68gx6bh3ei 2026-07-09 3/150 2026-07-10 06:33 by pbuc7it0i8
[硕博家园] 售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急 +3 ph7bxbho8f 2026-07-09 3/150 2026-07-10 05:53 by j4frgf6zcw
[教师之家] 售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急 +3 al9t2f50x3 2026-07-09 4/200 2026-07-10 05:33 by j4frgf6zcw
[考研] 售T0P一区SCI文章,我:8O5.51.O.54,科目齐全,可+急 +4 al9t2f50x3 2026-07-09 4/200 2026-07-10 05:33 by j4frgf6zcw
[基金申请] b口会评 +6 当空照 2026-07-08 6/300 2026-07-09 20:49 by tonyliu0401
[基金申请] 信息学部会评时间 +3 xuel2011 2026-07-06 3/150 2026-07-09 19:05 by mollyzhang_2003
[基金申请] 祈祷青基必中 50+3 hadengry 2026-07-09 9/450 2026-07-09 17:37 by 文杰猪猪
[考研] 在职考研 +6 wu5d 2026-07-08 7/350 2026-07-09 16:40 by 化工小霸王呀
[论文投稿] MSER送审了还被拒稿 +3 S778950906 2026-07-08 5/250 2026-07-09 15:46 by S778950906
[基金申请] 关于如何从代码看上不上会 +11 且听虎啸 2026-07-09 14/700 2026-07-09 15:27 by libeny
[有机交流] 硝基还原 20+3 暮年飞雪 2026-07-07 5/250 2026-07-09 13:30 by tfang
[基金申请] 化学口会评?应用基础研究和基础研究,希望能分开 +3 Tide man 2026-07-08 3/150 2026-07-09 11:36 by dede5556
[基金申请] 今年E04面上 +15 布布和一二 2026-07-05 21/1050 2026-07-09 10:25 by 学员fOzRO9
[硕博家园] 大龄残疾硕士的一点执念 +14 3776737374 2026-07-06 22/1100 2026-07-09 06:07 by lovechizi
[基金申请] 生命口会评 +4 wuke100666 2026-07-07 4/200 2026-07-08 16:38 by 逍遥不够自在
[教师之家] 网络举报学术不端成为了男女之间情杀的手段了,真荒唐。。。 +3 zju2000 2026-07-04 3/150 2026-07-07 21:00 by hyx552200
[有机交流] Suzuki偶联中硼酸酯原料掉下的硼酸酯是否可以自身偶联,生成B2Pin2杂质 500+3 天下大同 2026-07-06 3/150 2026-07-07 10:31 by martyr_oyx
[论文投稿] 刑法学论文投稿求助 +3 高源678 2026-07-04 5/250 2026-07-06 12:20 by 平天尺
[论文投稿] Journal of Environmental Chemical Engineering +3 雪花天涯 2026-07-05 3/150 2026-07-06 09:00 by bobvan
[基金申请] 最后一年,祈求好运 +3 pyw1992 2026-07-06 3/150 2026-07-06 08:53 by 苏_frp
信息提示
请填处理意见