| 查看: 2436 | 回复: 18 | ||
| 当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖 | ||
zhaohuxian木虫 (正式写手)
|
[求助]
请大侠帮忙看一下下面的 程序
|
|
|
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. 类似的另外一个程序运行没有问题 |
回复此楼» 猜你喜欢
93BebMhtakh前后11位开头都是大写
已经有5人回复
-
欢迎发来filecode的Mz6后的代码验证其规律
已经有86人回复
-
感觉是下周放榜了
已经有11人回复
-
filecode=后面第一个是大写字母
已经有10人回复
-
时间戳变了，能看出什么问题？
已经有4人回复
-
哪位老哥知道今年的国自然具体哪一天放榜？
已经有15人回复
-
今天系统多次维护，明天很可能放榜！
已经有9人回复
-
时间戳又变了8-15
已经有25人回复
-
2027广东省杰青
已经有6人回复
-
快农历七夕节了，轻松一下，男人悄悄话，女施主请不要进来。
已经有3人回复
zhaohuxian
木虫 (正式写手)
- 应助: 0 (幼儿园)
- 金币: 3090.5
- 散金: 2
- 帖子: 314
- 在线: 94.6小时
- 虫号: 474887
- 注册: 2007-12-06
- 性别: MM
- 专业: 凝聚态物性 II ：电子结构
送鲜花一朵 
18楼2012-03-09 10:48:48
lurencyj
木虫 (著名写手)
- 应助: 159 (高中生)
- 金币: 2869.2
- 散金: 520
- 红花: 8
- 沙发: 10
- 帖子: 1244
- 在线: 148.3小时
- 虫号: 888093
- 注册: 2009-10-29
- 性别: GG
- 专业: 凝聚态物性I:结构、力学和
2楼2012-03-07 21:23:48
zhaohuxian
木虫 (正式写手)
- 应助: 0 (幼儿园)
- 金币: 3090.5
- 散金: 2
- 帖子: 314
- 在线: 94.6小时
- 虫号: 474887
- 注册: 2007-12-06
- 性别: MM
- 专业: 凝聚态物性 II ：电子结构
3楼2012-03-07 21:29:07
uboat
银虫 (初入文坛)
- 应助: 3 (幼儿园)
- 金币: 397
- 帖子: 44
- 在线: 25.4小时
- 虫号: 627033
- 注册: 2008-10-15
- 性别: GG
- 专业: 生物电子学与生物信息处理
4楼2012-03-07 22:25:17
