版块导航: 正在加载中...

登录注册

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

24小时热门版块排行榜

返回列表

本帖产生 3 个程序强帖，点击这里进行查看

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

Gina88

木虫 (正式写手)

应助: 9 (幼儿园)
金币: 3328.8
散金: 124
红花: 8
帖子: 395
在线: 113小时
虫号: 1047684
注册: 2010-06-26
专业: 理论和计算化学

[求助] 写了一个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

回复此楼

» 猜你喜欢

回收溶剂求助已经有7人回复
职称评审没过，求安慰已经有40人回复
硝基苯如何除去已经有3人回复
A期刊撤稿已经有4人回复
垃圾破二本职称评审标准已经有17人回复
投稿Elsevier的Neoplasia杂志，到最后选publishing options时页面空白，不能完成投稿已经有22人回复
申请26博士已经有5人回复
EST投稿状态问题已经有7人回复
毕业后当辅导员了，天天各种学生超烦已经有4人回复
求助文献已经有3人回复

1楼 2011-05-04 17:51:43

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

Gina88

木虫 (正式写手)

应助: 9 (幼儿园)
金币: 3328.8
散金: 124
红花: 8
帖子: 395
在线: 113小时
虫号: 1047684
注册: 2010-06-26
专业: 理论和计算化学

引用回帖:

Originally posted by snoopyzhao at 2011-05-09 19:29:37:
程序中还有两处错误

请将程序中两处：

CODE:

do k=2,FFTx*FFTy*FFTz

改为

CODE:

do k=1,FFTx*FFTy*FFTz

谢谢您！您给我的程序所用内存比我的应该节省很多，运行实现了我想要的功能。真的非常感谢！

从得到您写的程序我一直在看，大部分能看懂。
除了下面读写
augmentation occupancies 1  33
  0.5246464E+00 -0.3787519E+00  0.5632211E-24  0.9813096E-01 -0.5674925E-24
  0.1721307E-24 -0.6489097E-01 -0.1721307E-24  0.3600302E+00  0.0000000E+00
  0.5255511E+00  0.0000000E+00 -0.2341957E-25  0.1750307E+00  0.2692635E-26
  0.7649248E+00  0.0000000E+00  0.1090754E-24  0.2306250E+00 -0.1012863E-24
  0.5314240E-17  0.2497328E+00  0.0000000E+00  0.5526112E-25  0.8797233E-01
-0.6241027E-25  0.4471885E-17  0.2937433E-01  0.0000000E+00 -0.2790149E-26
  0.1616863E-01  0.3756390E-26 -0.2151094E-18
augmentation occupancies 2  33
  0.5478887E+00  0.1007788E+00  0.1268635E-24 -0.5136288E-01 -0.1258005E-24
  0.2057362E-25  0.4940735E-01 -0.2461255E-25  0.1845513E-01  0.3143559E-24
  0.1146283E+00 -0.3276243E-24 -0.2114718E-25  0.3425659E-01  0.2167872E-25
  0.1329006E+01  0.0000000E+00 -0.8091556E-25  0.8198887E-01  0.8251071E-25
  0.4708363E-18  0.3142530E+00 -0.1295663E-26  0.6056954E-25  0.6759688E-01
-0.7514666E-25 -0.2222845E-17  0.2562290E-01  0.0000000E+00  0.1816476E-25
  0.1262322E-01 -0.1922575E-25  0.1530643E-18
  0.100000000000E+01  0.100000000000E+01
  160  160  160
部分的程序之外，这部分能看出来是反复读取和写入，可是怎么判断循环结束还是看不懂。另外
160 160 160没有看见读，怎么就能写入了呢。
这个程序真是奇妙啊。
也就高手能写出这样的程序。
要是我自己，打死我也想不出还有这个写法。
真的非常感谢snoopyzhao 了：）

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

赞一下

回复此楼

49楼2011-05-10 00:52:37

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

查看全部 60 个回答

Gina88

木虫 (正式写手)

应助: 9 (幼儿园)
金币: 3328.8
散金: 124
红花: 8
帖子: 395
在线: 113小时
虫号: 1047684
注册: 2010-06-26
专业: 理论和计算化学

这个是cell的内容
%BLOCK LATTICE_CART
   12.782529349912258    -0.000000000000028    0.000000000000001
   -0.000000000000000    13.529995000000000    0.000000000000001
   0.000000000000000    0.000000000000000    10.000000000000000
%ENDBLOCK LATTICE_CART

%BLOCK POSITIONS_FRAC
  H 0.0555000007152556 0.1666999995708470 0.5000000000000000
  H 0.2221666673819220 0.0666999995708464 0.5000000000000000
  H 0.1110555562708110 0.0666999995708466 0.5000000000000000
  H 0.1110555562708110 0.0666999995708466 0.5000000000000000
  C 0.2777222229374780 0.1666999995708470 0.5000000000000000
  C 0.3888333340485890 0.1666999995708470 0.5000000000000000
  C 0.5555000007152560 0.0666999995708465 0.5000000000000000
  S 0.4443888896041450 0.0666999995708466 0.5000000000000000
  S 0.6110555562708110 0.1666999995708470 0.5000000000000000
  si 0.6110555562708110 0.1666999995708470 0.5000000000000000
%ENDBLOCK POSITIONS_FRAC

赞一下

回复此楼

2楼2011-05-04 17:52:59

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

Gina88

木虫 (正式写手)

应助: 9 (幼儿园)
金币: 3328.8
散金: 124
红花: 8
帖子: 395
在线: 113小时
虫号: 1047684
注册: 2010-06-26
专业: 理论和计算化学

那个笑脸：）是
冒号+右括号

那个红脸”）是
右括号

赞一下

回复此楼

3楼2011-05-04 17:56:30

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

Gina88

木虫 (正式写手)

应助: 9 (幼儿园)
金币: 3328.8
散金: 124
红花: 8
帖子: 395
在线: 113小时
虫号: 1047684
注册: 2010-06-26
专业: 理论和计算化学

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(

赞一下

回复此楼

4楼2011-05-04 17:58:28

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

查看全部 60 个回答