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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 写了一个fortran90的小程序，编译通不过，请大侠帮忙
303/3返回列表上一页123
查看: 3893  |  回复: 59
查看全部回帖 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
本帖产生 3 个 程序强帖 ，点击这里进行查看
当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

Gina88

木虫 (正式写手)

[求助] 写了一个fortran90的小程序，编译通不过，请大侠帮忙

program cell-POSCAR

!announcement begin***********************************
implicit none
real(8)::cellcon(3,3)       !lattice constance
real(8),allocatable::atomcoor(:,  !direct coordinate of atoms
integer,allocatable::type(
integer i,j,k,m,n           !m:atom number,n:type number
character(len=1) nonsense    !to contain something that will not be used
character(len=2) position   !to read %
character(len=2) element1,element2  
!End announcement************************************

!Begin reading data from "cell"****************************
open(unit=18,file="cell",status="old"
read(18,*)nonsense
do i=1,3  
  read(18,*)cellcon(i,1),cellcon(i,2),cellcon(i,3)
end do
read(18,*)position
read(18,*)nonsense
read(18,*)nonsense
n=0;m=0
read(18,*)element2
do while(position/=element2)
  n=n+1
  element1=element2
  do while(element1==element2)
    m=m+1
    read(18,*)element2
  end do
end do
close(18)

allocate(type(n))
allocate(atomcoor(m,3))

open(unit=28,file="cell",status="old"
read(28,*)nonsense
read(28,*)nonsense
read(28,*)nonsense
read(28,*)nonsense
read(28,*)nonsense
read(28,*)nonsense
read(28,*)nonsense
read(28,*)element2,atomcoor(1,1),atomcoor(1,2),atomcoor(1,3)
i=1;k=1
element1=element2
if (m==1) then
  type(1)=1
else if
  do j=2,m
    read(28,*)element2,atomcoor(j,1),atomcoor(j,2),atomcoor(j,3)
    if(element1==element2) then
      k=k+1
      if(m==j) type(i)=k
    else if
      type(i)=k
      i=i+1
      element1=element2
      k=1
      if(m==j) type(i)=k
    end if   
  end do
end if
close(28)
!End reading data from "cell"****************************

!Begin writing to "POSCAR"******************************
open(unit=38,file="POSCAR",status="replace"
write(38,10)System
write(38,100)cellcon(1,1)
do i=1,3
  write(38,200)(cellcon(i,j)/cellcon(1,1),j=1,3)
end do
write(38,60)(type(i),i=1,n)
write(38,20)Selective,dynamic
write(38,30)Direct
do i=1,m
  write(38,300)(atomcoor(i,j),j=1,3)
end do
10 FORMAT(1X,A6)
20 FORMAT(1X,A9,1X,A7)
30 FORMAT(1X,A6)
60 FORMAT(1X,n(I3,2X))
100 FORMAT(1X,F18.16)
200 FORMAT(1X,3(F18.16,3X))
300 FORMAT(1X,F18.16,2X,F18.16,2X,F18.16,2X,'T',2X,'T',2X,'T')
close(38)
!End writing to "POSCAR"********************************

end
回复此楼

» 猜你喜欢
1楼 2011-05-04 17:51:43
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
引用回帖:
Originally posted by Gina88 at 2011-05-09 10:33:24:
嗯，这次上传EIGENVAL了。
谢谢啦：）

给个 spin=2 时的 CHGCAR1 文件看一下……
赞一下 回复此楼
42楼2011-05-09 14:29:27
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

引用回帖:
Originally posted by Gina88 at 2011-05-09 09:51:06:
en，相减的数据不包含augmentation occupancies的那部分，
相减的是384 160 24以下，augmentation occupancies以上的那部分数据。
即CHGCAR1=CHGCAR1-CHGCAR2。

谢谢大侠了！

数据就是EIGENVAL，还有C ...

给一个实现，但与你最初的想法可能不一样，由于你只进行部分差减，因为除此以外部分的数据，全部以字符串形式读入与输出，只定义为数不多几个数组，而且把数组的维数也降下来，你看一下吧……
CODE:
program diff_CHGCAR

!announcement begin********************
implicit none
real(8),allocatable::densityup(:,:)
real(8),allocatable::densitydn(:,:)
integer,allocatable::atomnum(:)
integer i,k,n,ios,fileunit
integer filenum,atomsum,typenum,line_len
integer FFTx,FFTy,FFTz
character(len=80)::line
character(len=80)::filename
character(len=80)::subline
!End announcement**********************

!Begin reading data from "EIGENVAL"******
real(8)::atomnum1,atomnum2,notkown3
integer spin                    
open(unit=18,file="EIGENVAL")
read(18,*)atomnum1,atomnum2,notkown3,spin
close(18)
!End reading data from "EIGENVAL"********

write(*,*)"number of files:(2 or 3?)"
read(*,*)filenum

open(unit=68,file="CHGCAR",status="replace")

do n=1,filenum
   write(filename,'(a,i0)') 'CHGCAR',n
   fileunit = 28 + n-1
   open(unit=fileunit,file=filename,status='old')
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   do i=1,3
      read(fileunit,'(a)')line
      if (n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)')line
   if (n==1) then
      write(68,'(a)') trim(line)
      line=adjustl(line)
      line_len=len_trim(line)
      typenum=1
      do i=1,line_len
         if(line(i:i)==' ' .and. line(i:i+1)/=' ') typenum=typenum+1
      end do
      allocate(atomnum(typenum))
   end if
   read(fileunit,'(a)') line
   if (n==1) then
      write(68,'(a)') trim(line)
      read(line,*) (atomnum(i),i=1,typenum)
      atomsum=sum(atomnum)
   end if
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   do i=1,atomsum
      read(fileunit,'(a)') line
      if(n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)')
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   subline = adjustl(line)
   read(line,*) FFTx,FFTy,FFTz
   if (n==1)  allocate(densityup(FFTx*FFTy*FFTz,filenum))
   read(fileunit,*)(densityup(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densityup(k,1) = densityup(k,1)-densityup(k,n)
      end do
   end if
if (spin /=2 .and. n/=1) close(fileunit)
end do

write(68,'(5e16.9)')(densityup(k,1),k=1,FFTx*FFTy*FFTz)

do n=1,filenum
   fileunit = 28 + n-1
   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit
   if (n == 1) then
       write(68,'(a)') trim(line)
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if
   read(fileunit, *) (densityup(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densityup(k,1) = densityup(k,1)-densityup(k,n)
      end do
   end if
   if(n/=1) close(fileunit)
end do

if (spin == 2) then
   write(68,'(5e16.9)')(densitydn(k,1),k=1,FFTx*FFTy*FFTz)
   do
      read(28,'(a)',iostat=ios) line
      if (ios < 0) exit
      write(68,'(a)') trim(line)
   end do
end if

close(28)
close(68)
stop
end
赞一下 回复此楼
44楼2011-05-09 16:41:46
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
微尘、梦想(金币+2): 2011-05-09 18:07:21
上面的程序中有一个地方错了，更正了一下：
CODE:
program diff_CHGCAR

!announcement begin********************
implicit none
real(8),allocatable::densityup(:,:)
real(8),allocatable::densitydn(:,:)
integer,allocatable::atomnum(:)
integer i,k,n,ios,fileunit
integer filenum,atomsum,typenum,line_len
integer FFTx,FFTy,FFTz
character(len=80)::line
character(len=80)::filename
character(len=80)::subline
!End announcement**********************

!Begin reading data from "EIGENVAL"******
real(8)::atomnum1,atomnum2,notkown3
integer spin                    
open(unit=18,file="EIGENVAL")
read(18,*)atomnum1,atomnum2,notkown3,spin
close(18)
!End reading data from "EIGENVAL"********

write(*,*)"number of files:(2 or 3?)"
read(*,*)filenum

open(unit=68,file="CHGCAR",status="replace")

do n=1,filenum
   write(filename,'(a,i0)') 'CHGCAR',n
   fileunit = 28 + n-1
   open(unit=fileunit,file=filename,status='old')
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   do i=1,3
      read(fileunit,'(a)')line
      if (n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)')line
   if (n==1) then
      write(68,'(a)') trim(line)
      line=adjustl(line)
      line_len=len_trim(line)
      typenum=1
      do i=1,line_len
         if(line(i:i)==' ' .and. line(i:i+1)/=' ') typenum=typenum+1
      end do
      allocate(atomnum(typenum))
   end if
   read(fileunit,'(a)') line
   if (n==1) then
      write(68,'(a)') trim(line)
      read(line,*) (atomnum(i),i=1,typenum)
      atomsum=sum(atomnum)
   end if
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   do i=1,atomsum
      read(fileunit,'(a)') line
      if(n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)')
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   subline = adjustl(line)
   read(line,*) FFTx,FFTy,FFTz
   if (n==1)  allocate(densityup(FFTx*FFTy*FFTz,filenum))
   read(fileunit,*)(densityup(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densityup(k,1) = densityup(k,1)-densityup(k,n)
      end do
   end if
if (spin /=2 .and. n/=1) close(fileunit)
end do

write(68,'(5e16.9)')(densityup(k,1),k=1,FFTx*FFTy*FFTz)

do n=1,filenum
   fileunit = 28 + n-1
   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit
   if (n == 1) then
       write(68,'(a)') trim(line)
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if
   read(fileunit, *) (densitydn(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densitydn(k,1) = densitydn(k,1)-densitydn(k,n)
      end do
   end if
   if(n/=1) close(fileunit)
end do

if (spin == 2) then
   write(68,'(5e16.9)')(densitydn(k,1),k=1,FFTx*FFTy*FFTz)
   do
      read(28,'(a)',iostat=ios) line
      if (ios < 0) exit
      write(68,'(a)') trim(line)
   end do
end if

close(28)
close(68)
stop
end
赞一下(1人) 回复此楼
45楼2011-05-09 16:45:24
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★
余泽成(金币+1): 谢谢参与应助！ 2011-05-19 19:22:17
其实，densitydn也不是必须的。densityup 用完之后，还可以用来盛放 densitydn 的东西，这两个数组是一样的大小的。如果不要 densitydn，那么程序内存占用可能会减小近一半。
赞一下(1人) 回复此楼
46楼2011-05-09 16:47:55
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★ ★
微尘、梦想(金币+2): 谢谢如此耐心的回答！ 2011-05-09 18:07:47
哦，在
CODE:
write(68,'(5e16.9)')(densityup(k,1),k=1,FFTx*FFTy*FFTz)

之后，应该加上 DEALLOCATE(densityup)

同样，在
CODE:
write(68,'(5e16.9)')(densitydn(k,1),k=1,FFTx*FFTy*FFTz)

之后，也应该加上DEALLOCATE(densitydn)
赞一下(1人) 回复此楼
47楼2011-05-09 17:02:17
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★
余泽成(金币+1): 谢谢参与应助！ 2011-05-19 19:22:33
程序中还有两处错误

请将程序中两处：
CODE:
do k=2,FFTx*FFTy*FFTz

改为
CODE:
do k=1,FFTx*FFTy*FFTz
赞一下(1人) 回复此楼
48楼2011-05-09 19:29:37
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
微尘、梦想(金币+2): 2011-05-10 19:03:47
引用回帖:
Originally posted by Gina88 at 2011-05-10 00:52:37:
谢谢您！您给我的程序所用内存比我的应该节省很多，运行实现了我想要的功能。真的非常感谢！

从得到您写的程序我一直在看，大部分能看懂。
除了下面读写
augmentation occupancies   1  33
  0.5246464E ...

部分的程序之外，这部分能看出来是反复读取和写入，可是怎么判断循环结束还是看不懂。另外
160 160 160没有看见读，怎么就能写入了呢。
这个程序真是奇妙啊。
也就高手能写出这样的程序。
要是我自己，打死我也想不出还有这个写法。
真的非常感谢snoopyzhao 了：）

在进入下面这个循环之前，如果是 spin ==2，那么所有的文件都没有关闭，如果是 spin /=2，那么除文件 1 以外都关闭了。

   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit !这一行是判断是不是 160 160 160 那行的。如果是跳出读 augmentation occupancies 部分的循环。
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit ! 如果 spin /=2，程序到这里已经结束了，因为 iostat 显示已经读到文件的最后了……
   if (n == 1) then
       write(68,'(a)') trim(line) !这就是写 160 160 160 那一行的
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if

后面应该是这个部分一样，但那只是关系 spin ==2 的事了……
赞一下(1人) 回复此楼
50楼2011-05-10 06:50:40
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

引用回帖:
Originally posted by Gina88 at 2011-05-10 10:40:20:
snoopyzhao ：其它的我都看明白了，下面一行我上网查了查，trim是去掉字符串前后的空格之后的字符串。
index是看后面的字符串在前面字符串中的位置，如果这个位置不为0，就离开。如果为0就继续。
可是其它行 ...

你知道 subline 中的字符串是啥？ '160 160 160'，我把前后的空格都去掉是为了更好的匹配……至于要不要去掉，我还真没有试，我只是觉得这种特征字符串的前后不应该有空格....
赞一下 回复此楼
52楼2011-05-10 10:45:37
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
微尘、梦想(金币+2): 2011-05-10 19:04:04
引用回帖:
Originally posted by Gina88 at 2011-05-10 11:06:29:
谢谢您！
这句话应该不能去掉的，如果去掉就不能实现密度矩阵相减的功能了。
但是我又不明白 if (index (line, trim(subline)) /= 0) exit这句话为什么判断的就是160 160 160那行呢，而不是其它行呢。

16 ...

这样吧，

index('    a b c d        ', 'a b c d') 的结果是啥？

index('    a b c d        ', '    a b c d') 的结果是啥？

index('    b b c d        ', 'a b c d') 的结果又是啥？

这跟空格没有关系，只是前面的那个字符串是否包括后面的字符串，如果包括，返回后面这个字符串第一个字符在前面字符串中的位置……
赞一下(1人) 回复此楼
54楼2011-05-10 11:12:34
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 Gina88 的主题更新
303/3返回列表上一页123
普通表情 龙 兔 虎 猫
信息提示
关闭
请填处理意见
关闭