24小时热门版块排行榜    

北京石油化工学院2026年研究生招生接收调剂公告
查看: 2993  |  回复: 8
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

chk0521

金虫 (初入文坛)

[交流] 【求助成功】Band-procar 和Dos-procar 程序执行出错 已有8人参与

我从版内下载的分析PROCAR的程序Band-procar.f 和Dos-procar.f 通过g77 编译成可执行文件。但是执行后出现segmentation fault (core dumped)错误提示。这是为什么啊?我上网查了一下这表示指针使用出错。我的编程水平太差实在查不出问题在哪。麻烦哪位高人指点一下,十分感谢!以下是源程序
    implicit real*8(a-h,o-z)
      parameter (nbd = 200)
      parameter (nkd = 500)
      parameter (nxd = 300)
      parameter (natmd = 20)
      dimension a(3,3),b(3,3),c(3),e(nkd,nbd),sk(nkd,3)
      dimension xx(nxd) ,wei(nkd)
      dimension dump(20),oc(nkd,nbd,natmd,4)
      open(7,file='PROCAR',form='FORMATTED',status='OLD')
      pi = 3.141592654
      read(7,103) dump                    

      write(*,*) 'Spin polarized calculation? (no=1,yes=2):'
      read (*,*) ispin
      if ((ispin.ne.1).and.(ispin.ne.2)) then
      write(*,*) ' INPUT ERROR, ispin must equal to 1 or 2 '
      stop
      endif

c     write(*,*) 'Enter # of interval (npoints) and division (ndiv):'
c     read (*,*) npoints,ndiv
      open(9,file='KPOINTS',form='FORMATTED',status='OLD')
      read(9,100) temp
      read(9,*) ndiv

      write(*,*) 'Enter the range of energy to plot:'
      read (*,*) er1,er2
      emin=min(er1,er2)
      emax=max(er1,er2)
      write(*,*) 'Enter the value of fermi energy:'
      read(*,*)  ef

      if (ispin.eq.1) then
      open(11,file='band.dat')
      elseif (ispin.eq.2) then
      open(11,file='band-up.dat')
      open(12,file='band-dn.dat')
      endif

      open(8,file='POSCAR',form='FORMATTED',status='OLD')
      read(8,100) temp
c      write(6,100) temp
100   format(20a4)
      read (8,*) aa
c      WRITE(6,*) aa
c   
c      *** read lattice constant from POSCAR**
c            
      do i=1,3
         read (8,*) (a(i,j),j=1,3)
c       WRITE(6,500) (a(i,j),j=1,3)
500   format (3f12.8)
      enddo
      do i=1,3
         do j=1,3
         a(i,j)=aa*a(i,j)
         enddo
c       WRITE(6,500) (a(i,j),j=1,3)
      enddo
c
c     *** read lattice vector from POSCAR***
c
      volume=a(1,1)*a(2,2)*a(3,3)+a(1,2)*a(2,3)*a(3,1)
     &+a(1,3)*a(2,1)*a(3,2)-a(1,1)*a(2,3)*a(3,2)
     &-a(1,2)*a(2,1)*a(3,3)-a(1,3)*a(2,2)*a(3,1)
      do i=1,3
          if (i .eq. 1) then
            j=2
            k=3
          else if (i .eq. 2) then
            j=3
            k=1
          else
            j=1
            k=2
          endif
        c(1)=a(j,2)*a(k,3)-a(j,3)*a(k,2)
        c(2)=a(j,3)*a(k,1)-a(j,1)*a(k,3)
        c(3)=a(j,1)*a(k,2)-a(j,2)*a(k,1)
        do j=1,3
           b(i,j)=2*pi*c(j)/volume
c         WRITE (6,*) b(i,j)
        enddo
       enddo


      do 9000 isp=1,ispin

      read(7,104) nk,nband,nion
      do 1000 k = 1,nk
      read(7,103) dump
      read(7,105) kp,(sk(k,j),j=1,3),wei(k)
c     write(6,105) kp,(sk(k,j),j=1,3),wei(k)
      read(7,103) dump
      do  nb = 1,nband
      read(7,106) nb1,e(k,nb),occ
c     write(6,106) nb1,e(k,nb),occ
      read(7,103) dump
      read(7,103) dump
c     write(6,*) 'nion=',nion
      niont = nion +1
      if (nion .eq. 1) niont = 1
      do  ion = 1,niont
      read(7,107) (oc(k,nb,ion,j),j=1,4)
c     write(6,107) (oc(k,nb,ion,j),j=1,4)
      enddo
      read(7,103) dump
c     write(6,103) dump
      enddo
1000 continue

      weight = 0.0
      do k = 1, nk
      weight = weight + wei(k)
      enddo

      do k = 1,nk
      wei(k) =  wei(k) / weight
      enddo

101  format(10x,f9.5)
102  format(f10.5)
103  format(20a4)
104  format(16x,i3,20x,i5,19x,i4)
105  format(10x,i3,5x,3f11.8,13x,f11.8)
106  format(4x,i4,9x,f14.8,7x,f12.8)
107  format(3x,4f7.3)


c
c     *** find reciprocal lattice vector ***
      xx(1) = 0.0
      nn = 1
      do k = 1,nk-1
      dkx=(sk(k+1,1)-sk(k,1))*b(1,1) + (sk(k+1,2)-sk(k,2))*b(2,1)
     &   + (sk(k+1,3)- sk(k,3))*b(3,1)
      dky=(sk(k+1,1)-sk(k,1))*b(1,2) + (sk(k+1,2)-sk(k,2))*b(2,2)
     &   + (sk(k+1,3)- sk(k,3))*b(3,2)
      dkz=(sk(k+1,1)-sk(k,1))*b(1,3) + (sk(k+1,2)-sk(k,2))*b(2,3)
     &   + (sk(k+1,3)- sk(k,3))*b(3,3)
      del =  sqrt ( dkx**2 + dky**2 + dkz**2 )
      nn = nn +1
      xx(nn) = xx(nn-1) + del
      enddo

      do n=1,nband
        if (mod(n,2).ne.0) then
         do k=1,nk
          ee = e(k,n) - ef
          if ( ee .gt. emax ) ee = emax
          if ( ee .lt. emin ) ee = emin
         write (10+isp,300) xx(k),ee
         enddo
        elseif (mod(n,2).eq.0) then
         do i=nk,1,-1
          ee = e(i,n) - ef
          if ( ee .gt. emax ) ee = emax
          if ( ee .lt. emin ) ee = emin
          write (10+isp,300) xx(i),ee
         enddo
        endif
      enddo
300   format (f12.8,2x,f12.8)

      if (mod(nband,2) .ne. 0) then
          write (10+isp,300) xx(nk),emin
          write (10+isp,300) xx(1),emin
      else
          write (10+isp,300) xx(1),emin
      endif
c
c     *** write xx-ee ***
c
        npoints=nk/ndiv
       do n=2,npoints
         kk=(n-1)*ndiv
        write (10+isp,300) xx(kk),emin
        write (10+isp,300) xx(kk),emax
        write (10+isp,300) xx(kk),emin
      enddo
        write (10+isp,300) xx(nk),emin
        write (10+isp,300) xx(nk),emax
        write (10+isp,300) xx(1),emax
        write (10+isp,300) xx(1),emin
        zero=0.0
        write (10+isp,300) xx(1),zero
        write (10+isp,300) xx(nk),zero

9000  continue

      stop
      end

[ Last edited by chk0521 on 2010-6-25 at 16:36 ]
回复此楼

» 猜你喜欢

» 本主题相关价值贴推荐,对您同样有帮助:

已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

fqpwork

银虫 (小有名气)


小木虫(金币+0.5):给个红包,谢谢回帖
引用回帖:
1楼: Originally posted by chk0521 at 2010-06-21 18:59:33:
我从版内下载的分析PROCAR的程序Band-procar.f 和Dos-procar.f 通过g77 编译成可执行文件。但是执行后出现segmentation fault (core dumped)错误提示。这是为什么啊?我上网查了一下这表示指针使用出错。我的编 ...

你好,两个小程序可不可以发给我一下,谢谢。fqp36@qq.com
6楼2011-09-21 00:19:44
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 9 个回答

lvjian8596

木虫 (小有名气)

★ ★
小木虫(金币+0.5):给个红包,谢谢回帖交流
zzy870720z(金币+1):感谢交流 2010-06-24 08:50:43
segmentation fault (core dumped)出现这个问题很有可能是数组越界!
程序本身没有问题,但是当你的数据过大时可能出现问题!
比如一个数组a(100),但是你有200个数据读进来,这时可能出现这个问题!
2楼2010-06-24 08:44:53
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

chk0521

金虫 (初入文坛)

zzy870720z:如果问题解决,帮忙把【求助】改为【求助成功】,谢谢合作,如果在整理出解决办法,给予奖励,呵呵 2010-06-24 17:32:28
谢谢斑竹!确实是数组越界。已经解决了:)

[ Last edited by chk0521 on 2010-6-25 at 16:37 ]
3楼2010-06-24 15:51:51
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

calos818

木虫 (著名写手)

新人菜鸟


小木虫(金币+0.5):给个红包,谢谢回帖交流
引用回帖:
Originally posted by chk0521 at 2010-06-24 15:51:51:
谢谢斑竹!确实是数组越界。已经解决了:)

[ Last edited by chk0521 on 2010-6-25 at 16:37 ]

请问你做了哪些修改的,麻烦你提示下,谢谢
4楼2010-10-24 18:23:05
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
普通表情 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 274求调剂 +4 xiao爱同学 2026-03-30 4/200 2026-03-31 00:04 by jp9609
[考研] 食品工程专硕一志愿中海洋309求调剂 +4 小张zxy张 2026-03-26 9/450 2026-03-30 23:39 by 小张zxy张
[考研] 083000环境科学与工程调剂,总分281 +3 橙子(胜意) 2026-03-30 3/150 2026-03-30 20:07 by piklet
[考研] 332求调剂 +14 032500 2026-03-25 14/700 2026-03-30 20:03 by 无际的草原
[考研] 346求调剂 一志愿070303有机化学 +7 萝卜炖青菜 2026-03-28 8/400 2026-03-30 19:59 by 无际的草原
[考研] 一志愿郑州大学,080500学硕,总分317分求调剂 +10 举个栗子oi 2026-03-24 11/550 2026-03-30 19:31 by michael2011
[考研] 311求调剂 +10 lin0039 2026-03-26 10/500 2026-03-30 10:26 by herarysara
[考研] 求调剂 +10 张zz111 2026-03-27 11/550 2026-03-30 09:17 by 无际的草原
[考研] 一志愿北京工业大学,324分求调剂 +6 零八# 2026-03-28 6/300 2026-03-29 21:20 by nanaliuyun
[硕博家园] 招收生物学/细胞生物学调剂 +4 IceGuo 2026-03-26 5/250 2026-03-29 01:25 by griffith2014
[考研] 0856,材料与化工321分求调剂 +12 大馋小子 2026-03-27 13/650 2026-03-28 10:56 by self2008
[考研] 086502化学工程342求调剂 +6 阿姨复古不过 2026-03-27 6/300 2026-03-28 07:06 by wangy0907
[考研] 330一志愿中国海洋大学 化学工程 085602 有读博意愿 求调剂 +3 wywy.. 2026-03-27 4/200 2026-03-28 03:32 by fmesaito
[考博] 26申博 +3 加油冲啊! 2026-03-26 3/150 2026-03-27 15:38 by cls512
[考研] 314求调剂 +3 溪云珂 2026-03-26 3/150 2026-03-27 11:20 by sanrepian
[考研] 调剂 +3 李嘉图·S·路 2026-03-27 3/150 2026-03-27 11:19 by wangjy2002
[考研] 材料求调剂 +5 .m.. 2026-03-25 5/250 2026-03-27 11:08 by 不吃魚的貓
[考研] 机械学硕310分,数一英一,一志愿211本科双非找调剂信息 +3 @357 2026-03-25 3/150 2026-03-26 16:34 by by.MENG
[考研] 281求调剂 +6 Koxui 2026-03-24 7/350 2026-03-26 15:37 by 无际的草原
[考研] 材料专硕331求调剂 +4 鲜当牛 2026-03-24 4/200 2026-03-24 15:58 by JourneyLucky
信息提示
请填处理意见