24小时热门版块排行榜

返回列表

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

zhaohuxian

木虫 (正式写手)

应助: 0 (幼儿园)
金币: 3090.5
散金: 2
帖子: 314
在线: 94.6小时
虫号: 474887
注册: 2007-12-06
性别: MM
专业: 凝聚态物性 II ：电子结构

[求助] 请大侠帮忙看一下下面的程序

program angle

!Define the parameters

   implicit real*8(a-h,o-z)
   parameter (x=10000)
   parameter (y=10000)
   parameter (radtodeg=57.29577951d0)

integer i, j, atomkind, lower, upper
integer iatom(x)

   dimension rv(3,3),temp(6)
   dimension dx(x,y), dy(x,y), dz(x,y)

   character(len=132) line, system
   character*4 lable(x), latom(x,y)

   double precision lattice

   logical eof, con, out

eof=.false.
con=.false.
out=.false.

! Check the required files

inquire(file='OUTCAR',exist=out)
inquire(file='CONTCAR',exist=con)

if (.not. out) then
print *, "OUTCAR: file not exist."
stop
end if

if (.not. con) then
print *, "CONTCAR: file not exist."
stop
end if

! Read the species in OUTCAR

open(unit=out,file='OUTCAR',status='OLD')
atomkind=0
do while(.not.eof)
   read(out,*,end=10) line
   if(index(line,'VRHFIN').ne.0) then
      atomkind=atomkind+1
      upper=index(line,':')-1
      lower=index(line,'=')+1
      lable(atomkind)=line(lower:upper)
   end if
end do
close(out)
10 continue

   ! Read POSCAR to process lattice information and amount of each kind

open(unit=con,file='CONTCAR',status='OLD')
read(con,*,end=20) system
read(con,*,end=20) lattice
read(con,*,end=20) rv(1,1), rv(2,1), rv(3,1)
read(con,*,end=20) rv(1,2), rv(2,2), rv(3,2)
read(con,*,end=20) rv(1,3), rv(2,3), rv(3,3)
read(con,*,end=20), (iatom(i), i=1,atomkind)

! Process the label list
do i=1,atomkind
   do j=1,iatom(i)
      latom(j,i)=lable(i)
   end do
end do

do i=1,3
   temp(i)=0.0
   do j=1,3
      temp(i)=temp(i)+rv(j,i)**2
   end do
   temp(i)=sqrt(temp(i))
end do
a=temp(1)
b=temp(2)
c=temp(3)

do i=1,3
   temp(3+i)=0.0
end do

do j=1,3
   temp(4)=temp(4)+rv(j,2)*rv(j,3)
   temp(5)=temp(5)+rv(j,1)*rv(j,3)
   temp(6)=temp(6)+rv(j,1)*rv(j,2)
end do
temp(4)=temp(4)/(temp(2)*tem(3))
temp(5)=temp(5)/(temp(1)*tem(3))
temp(6)=temp(6)/(temp(1)*tem(2))

alpha=radtodeg*acos(temp(4))
beta=radtodeg*acos(temp(5))
gamma=radtodeg*acos(temp(6))

20 continue

   ! Open file for record, and write

open (11,file=opsition)
write(11,300) system
write(11,300) "lattice lengths: "
write(11,300) "a=", a
write(11,300) "b=", b
write(11,300) "c=", c
write(11,300) "lattice angles: "
write(11,300) "alpha=", alpha
write(11,300) "beta=", beta
write(11,300) "gamma=", gamma

close(con)

! Read OUTCAR to process the coordinates

open(unit=out,file='OUTCAR',status='OLD')
do while(.not.eof)
   read(out,*,end=30) line
   if (index(line,'POSITION').ne.0) then
   read(out,*,end=30) line

      do i=1,atomkind
      do j=1,iatom(i)
         read(out,*,end=30) dx(j,i), dy(j,i), dz(j,i)
         write(11,300) latom(j,i), dx(j,i), dy(j,i), dz(j,i)
      end do
      end do

   end if
end do
close(out)
30 continue

300 format(a4,1x,3f15.9,1x,a4,1x,i4,2(1x,a2),1x,f8.4,1x,i4)

stop
   end

编译通过了，但是云心的时候报错：

--------------------Configuration: adf - Win32 Debug--------------------
Linking...
main.obj : error LNK2001: unresolved external symbol _TEM@4
Debug/adf.exe : fatal error LNK1120: 1 unresolved externals
Error executing link.exe.

类似的另外一个程序运行没有问题

回复此楼

» 猜你喜欢

论文终于录用啦！满足毕业条件了已经有21人回复
不自信的我已经有5人回复
磺酰氟产物，毕不了业了！已经有4人回复
投稿Elsevier的杂志（返修），总是在选择OA和subscription界面被踢皮球已经有8人回复

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

1楼 2012-03-07 21:10:20

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

zhaohuxian

木虫 (正式写手)

应助: 0 (幼儿园)
金币: 3090.5
散金: 2
帖子: 314
在线: 94.6小时
虫号: 474887
注册: 2007-12-06
性别: MM
专业: 凝聚态物性 II ：电子结构

送鲜花一朵

引用回帖:

楼: Originally posted by snoopyzhao at 2012-03-07 23:17:32:
你的 cvf 好强啊……

你看一下下面的编译错误提示：

C:\Documents and Settings\Administrator\Desktop>gfortran -Wall -Wextra zf.f90
zf.f90:15.19:

dimension dx(x,y), dy(x,y), dz(x,y)
...

谢谢您的热心帮助，根据帖子里的错误信息，我改了程序：
program angle
!Define the parameters

   parameter (x=1000)
   parameter (y=1000)
   parameter (radtodeg=57.29577951d0)

integer i, j, atomkind, lower, upper
integer iatom(x)

   dimension rv(3,3),temp(6)
   dimension dx(x,y), dy(x,y), dz(x,y)

   character(len=132) line, system
   character*4 lable(x), latom(x,y)

   double precision lattice

   logical eof, con, out

eof=.false.
con=.false.
out=.false.

! Check the required files

inquire(file='OUTCAR',exist=out)
inquire(file='CONTCAR',exist=con)

if (.not. out) then
print *, "OUTCAR: file not exist."
stop
end if

if (.not. con) then
print *, "CONTCAR: file not exist."
stop
end if

! Read the species in OUTCAR

open(unit=12,file='OUTCAR',status='OLD')
atomkind=0
do while(.not.eof)
   read(12,*,end=10) line
   if(index(line,'VRHFIN').ne.0) then
      atomkind=atomkind+1
      upper=index(line,':')-1
      lower=index(line,'=')+1
      lable(atomkind)=line(lower:upper)
   end if
end do
close(12)
10 continue

   ! Read POSCAR to process lattice information and amount of each kind

open(unit=12,file='CONTCAR',status='OLD')
read(12,*,end=20) system
read(12,*,end=20) lattice
read(12,*,end=20) rv(1,1), rv(2,1), rv(3,1)
read(12,*,end=20) rv(1,2), rv(2,2), rv(3,2)
read(12,*,end=20) rv(1,3), rv(2,3), rv(3,3)
read(12,*,end=20), (iatom(i), i=1,atomkind)

! Process the label list
do i=1,atomkind
   do j=1,iatom(i)
      latom(j,i)=lable(i)
   end do
end do

do i=1,3
   temp(i)=0.0
   do j=1,3
      temp(i)=temp(i)+rv(j,i)**2
   end do
   temp(i)=sqrt(temp(i))
end do
a=temp(1)
b=temp(2)
c=temp(3)

do i=1,3
   temp(3+i)=0.0
end do

do j=1,3
   temp(4)=temp(4)+rv(j,2)*rv(j,3)
   temp(5)=temp(5)+rv(j,1)*rv(j,3)
   temp(6)=temp(6)+rv(j,1)*rv(j,2)
end do
temp(4)=temp(4)/(temp(2)*temp(3))
temp(5)=temp(5)/(temp(1)*temp(3))
temp(6)=temp(6)/(temp(1)*temp(2))

alpha=radtodeg*acos(temp(4))
beta=radtodeg*acos(temp(5))
gamma=radtodeg*acos(temp(6))

20 continue

   ! Open file for record, and write

open (11,file=opsition)
write(11,300) system
write(11,300) "lattice lengths: "
write(11,300) "a=", a
write(11,300) "b=", b
write(11,300) "c=", c
write(11,300) "lattice angles: "
write(11,300) "alpha=", alpha
write(11,300) "beta=", beta
write(11,300) "gamma=", gamma

close(con)

! Read OUTCAR to process the coordinates

open(unit=16,file='OUTCAR',status='OLD')
do while(.not.eof)
   read(16,*,end=30) line
   if (index(line,'POSITION').ne.0) then
   read(16,*,end=30) line

      do i=1,atomkind
      do j=1,iatom(i)
         read(1,*,end=30) dx(j,i), dy(j,i), dz(j,i)
         write(11,300) latom(j,i), dx(j,i), dy(j,i), dz(j,i)
      end do
      end do

   end if
end do
close(16)
30 continue

300 format(a4,1x,3f15.9,1x,a4,1x,i4,2(1x,a2),1x,f8.4,1x,i4)

   stop
end

赞一下

回复此楼

9楼2012-03-08 10:54:37

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

查看全部 19 个回答

lurencyj

木虫 (著名写手)

应助: 159 (高中生)
金币: 2869.2
散金: 520
红花: 8
沙发: 10
帖子: 1244
在线: 148.3小时
虫号: 888093
注册: 2009-10-29
性别: GG
专业: 凝聚态物性I:结构、力学和

【答案】应助回帖

★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★ ★
感谢参与，应助指数 +1
jjdg(金币+1): 感谢应助 2012-03-08 01:56:17
zhaohuxian(金币+30): ★有帮助 2 2012-03-08 09:01:51

不知道楼主是怎么写的程序，gfortran编译，一大堆Error！

赞一下

回复此楼

很女子很弓虽大