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

登录注册

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

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.

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

回复此楼

» 猜你喜欢

求调剂已经有5人回复
材料工程专硕 348分求调剂已经有5人回复
一志愿南大，0703化学，分数336，求调剂已经有3人回复
322求调剂已经有3人回复
0703化学调剂已经有4人回复
化学调剂已经有4人回复
297求调剂已经有3人回复
生物学调剂已经有3人回复
工科0856求调剂已经有3人回复
求调剂已经有3人回复

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-08 12:47:36:
把下面的错误更正了再说……

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

dimension dx(x,y), dy(x,y), dz(x,y)
1
Error: E ...

program angle
!Define the parameters

   integer,parameter :: x = 1000
   integer,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_ex, out_ex

eof=.false.
con_ex=.false.
out_ex=.false.

! Check the required files

inquire(file='OUTCAR',exist=out_ex)
inquire(file='CONTCAR',exist=con_ex)

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

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

! Read the species in OUTCAR

open(unit=11,file='OUTCAR',status='OLD')
atomkind=0
do while(.not.eof)
   read(11,*,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(11)
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)
close(12)

! 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 (21,file=opsition)
write(21,300) system
write(21,300) "lattice lengths: "
write(21,300) "a=", a
write(21,300) "b=", b
write(21,300) "c=", c
write(21,300) "lattice angles: "
write(21,300) "alpha=", alpha
write(21,300) "beta=", beta
write(21,300) "gamma=", gamma

close(21)

! Read OUTCAR to process the coordinates

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

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

   end if
end do
close(11)
close(21)
30 continue

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

   stop
end

谢谢，修改好了，x、y的声明错了

赞一下

回复此楼

14楼2012-03-09 09:16:09

已阅回复此楼关注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！

赞一下

回复此楼

很女子很弓虽大

2楼2012-03-07 21:23:48

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

zhaohuxian

木虫 (正式写手)

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

引用回帖:

楼: Originally posted by lurencyj at 2012-03-07 21:23:48:
不知道楼主是怎么写的程序，gfortran编译，一大堆Error！

不好意思，我也是第一次写程序，我是用CVF 6.5编译通过的
不知道哪里有问题，谢谢

赞一下

回复此楼

3楼2012-03-07 21:29:07

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

uboat

银虫 (初入文坛)

应助: 3 (幼儿园)
金币: 397
帖子: 44
在线: 25.4小时
虫号: 627033
注册: 2008-10-15
性别: GG
专业: 生物电子学与生物信息处理

【答案】应助回帖

★
感谢参与，应助指数 +1
jjdg(金币+1): 感谢应助 2012-03-08 01:56:28

temp(4)=temp(4)/(temp(2)*tem(3))
temp(5)=temp(5)/(temp(1)*tem(3))
temp(6)=temp(6)/(temp(1)*tem(2))

看最后的错误提示应该是这里的错误
里面没有定义tem的变量
楼主好好的看看

赞一下

回复此楼

4楼2012-03-07 22:25:17

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

查看全部 19 个回答

最具人气热帖推荐 [查看全部]		作者	回/看	最后发表

[考研] 求调剂 +5	十三加油 2026-03-21	5/250	2026-03-21 18:48 by 学员8dgXkO
[考研] 一志愿深大，0703化学，总分302，求调剂 +4	七月-七七 2026-03-21	4/200	2026-03-21 18:20 by 学员8dgXkO
[考研] 311求调剂 +3	勇敢的小吴 2026-03-20	3/150	2026-03-21 17:40 by ColorlessPI
[考研] 299求调剂 +5	shxchem 2026-03-20	7/350	2026-03-21 17:09 by ColorlessPI
[考研] 266求调剂 +3	哇呼哼呼哼 2026-03-20	3/150	2026-03-21 16:46 by barlinike
[考研] 材料学学硕080502 337求调剂-一志愿华中科技大学 +4	顺顺顺mr 2026-03-18	5/250	2026-03-21 10:22 by luoyongfeng
[考研] 能源材料化学课题组招收硕士研究生8-10名 +5	脱颖而出 2026-03-16	15/750	2026-03-21 10:16 by 脱颖而出
[考研] 求调剂 +6	Mqqqqqq 2026-03-19	6/300	2026-03-21 08:04 by JourneyLucky
[考研] 316求调剂 +6	梁茜雯 2026-03-19	6/300	2026-03-21 06:32 by Ecowxq666！
[考研] 一志愿中国石油大学（华东）本科齐鲁工业大学 +3	石能伟 2026-03-17	3/150	2026-03-21 02:22 by JourneyLucky
[考研] 324分 085600材料化工求调剂 +4	llllkkkhh 2026-03-18	4/200	2026-03-21 01:24 by JourneyLucky
[考研] 354求调剂 +5	Tyoumou 2026-03-18	8/400	2026-03-21 00:35 by JourneyLucky
[考研] 22408 344分求调剂一志愿华电计算机技术 +4	solanXXX 2026-03-20	4/200	2026-03-20 23:49 by alg094825
[考研] 353求调剂 +3	拉钩不许变 2026-03-20	3/150	2026-03-20 19:56 by JourneyLucky
[考研] 086500 325 求调剂 +3	领带小熊 2026-03-19	3/150	2026-03-20 18:38 by 尽舜尧1
[考研] 281求调剂（0805） +14	烟汐忆海 2026-03-16	25/1250	2026-03-20 15:47 by yuncha
[考研] 一志愿苏州大学材料工程（085601）专硕有科研经历三项国奖两个实用型专利一项省级立项 +6	大火山小火山 2026-03-16	8/400	2026-03-17 15:05 by 无懈可击111
[考研] 302求调剂 +4	小贾同学123 2026-03-15	8/400	2026-03-17 10:33 by 小贾同学123
[考研] [导师推荐]西南科技大学国防/材料导师推荐 +3	尖角小荷 2026-03-16	6/300	2026-03-16 23:21 by 尖角小荷
[考研] 070300化学学硕求调剂 +6	太想进步了0608 2026-03-16	6/300	2026-03-16 16:13 by kykm678

24小时热门版块排行榜

zhaohuxian

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

» 猜你喜欢

zhaohuxian

lurencyj

【答案】应助回帖

zhaohuxian

uboat

【答案】应助回帖

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