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

登录注册

应《网络安全法》要求，自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

回复此楼

» 猜你喜欢

一志愿中南化学337求调剂已经有5人回复
281求调剂（0805）已经有23人回复
265求调剂已经有9人回复
279分求调剂一志愿211 已经有10人回复
招收调剂硕士已经有12人回复
296求调剂已经有8人回复
招收博士1-2人已经有3人回复
085700资源与环境308求调剂已经有11人回复
274求调剂已经有8人回复
290求调剂已经有4人回复

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

大侠们，给点儿建议啊。。。已经有7人回复
CASTEP在计算是出现问题啦，求大侠帮忙啊。。。已经有13人回复
不同功能vasp的编译已经有4人回复
一个FORTRAN90程序，越界了，希望高手帮助已经有5人回复
请教一个fortran小程序编译出错的问题，谢谢已经有9人回复
有关fortran的一次而问题，希望大家能帮帮忙，谢谢已经有4人回复
【求助】用fortran怎么描述下面这样的情况，我是新手，请大家帮忙已经有8人回复
【求助】求Fortran90编译器？已经有11人回复
【求助】帮忙编个用于VASP小程序已经有22人回复

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

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

回帖支持 ( 显示支持度最高的前 50 名 )

snoopyzhao

至尊木虫 (职业作家)

程序强帖: 16
应助: 157 (高中生)
贵宾: 0.02
金币: 18844.7
红花: 29
帖子: 3803
在线: 1422.4小时
虫号: 183750
注册: 2006-02-13
专业: 污染生态化学

【答案】应助回帖

★ ★
Gina88(金币+3): 2011-05-04 22:29:31
Gina88(金币+2): 2011-05-04 22:29:54
余泽成(金币+2): 谢谢参与应助！ 2011-05-19 19:19:23

CODE:

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  

character(len=20) :: fm

!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

  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

      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(fm,'(a,i0,a)') '(1x,',n,'(i3,2x))'

write(38,fm)(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.15)

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

赞一下(2人)

回复此楼

6楼2011-05-04 19:06:16

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

普通回帖

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的回帖

Gina88

木虫 (正式写手)

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

非常非常感谢大侠了！！！！！！

赞一下

回复此楼

5楼2011-05-04 17:59:54

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

snoopyzhao

至尊木虫 (职业作家)

程序强帖: 16
应助: 157 (高中生)
贵宾: 0.02
金币: 18844.7
红花: 29
帖子: 3803
在线: 1422.4小时
虫号: 183750
注册: 2006-02-13
专业: 污染生态化学

★ ★
余泽成(金币+2): 谢谢参与应助！ 2011-05-19 19:19:36

谨慎地怀疑你以前没有写过 Fortran 的程序，或者也没有认真地看过书，否则不应该出现字符串两端不加引号，if 后面不跟判断语句的情况，呵呵……

你贴出来的程序根本就不能进行编译（即出现语法错误），那么要别人怎么帮你……

赞一下(1人)

回复此楼

7楼2011-05-04 19:08:49

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

Gina88

木虫 (正式写手)

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

引用回帖:

Originally posted by snoopyzhao at 2011-05-04 19:08:49:
谨慎地怀疑你以前没有写过 Fortran 的程序，或者也没有认真地看过书，否则不应该出现字符串两端不加引号，if 后面不跟判断语句的情况，呵呵……

你贴出来的程序根本就不能进行编译（即出现语法错误），那么要别 ...

您说的没错，我的确没有写过fortran程序，也没有仔细看过书。
几天前都不知道fortran的那些东西。
但是因为知道一点C语言，前面为了研究，得到了别人的程序代码。
看了一下，不懂的查百度，然后觉得程序不满意，就自己修改了，
因为简单，所以修改成功了。

后来就想着自己写点代码实现将那个cell文件转换成POSCAR，然后就胡乱写了上面的程序，因为前面得到别的程序都是77版的，而且都是数值，没有字符串的。大致的翻了翻书，现在这个书貌似很少啊，也查了查baidu，就稀里糊涂的写了。
字符串我猜到有错了，但是不知道该怎么弄，所以就发到这里来了。想着牛牛能帮我解决一下。

非常感谢您的指正。
不过能否详细一点告诉我什么地方语法错了，应该怎么改呢，流泪致谢了

赞一下

回复此楼

8楼2011-05-04 22:28:31

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

snoopyzhao

至尊木虫 (职业作家)

程序强帖: 16
应助: 157 (高中生)
贵宾: 0.02
金币: 18844.7
红花: 29
帖子: 3803
在线: 1422.4小时
虫号: 183750
注册: 2006-02-13
专业: 污染生态化学

引用回帖:

Originally posted by Gina88 at 2011-05-04 22:28:31:
您说的没错，我的确没有写过fortran程序，也没有仔细看过书。
几天前都不知道fortran的那些东西。
但是因为知道一点C语言，前面为了研究，得到了别人的程序代码。
看了一下，不懂的查百度，然后觉得程序不满 ...

你用我贴出来的，和你原来的程序之间作一个 diff 就知道了啊，呵呵……要不我给你贴一个 diff?

赞一下

回复此楼

9楼2011-05-04 22:38:39

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

snoopyzhao

至尊木虫 (职业作家)

程序强帖: 16
应助: 157 (高中生)
贵宾: 0.02
金币: 18844.7
红花: 29
帖子: 3803
在线: 1422.4小时
虫号: 183750
注册: 2006-02-13
专业: 污染生态化学

【答案】应助回帖

★ ★ ★ ★ ★
余泽成(金币+5, 程序强帖+1): 辛苦了！ 2011-05-04 22:55:55

zvv.f90 是你的程序
zv.f90 是我改后的程序

- 和 + 表示修改的部分，- 号代表你的程序，+ 代表修改后的程序……

CODE:

--- zvv.f90        2011-05-04 22:39:38.874875000 +0800

+++ zv.f90        2011-05-04 22:42:02.437375000 +0800

@@ -1,4 +1,4 @@

-program cell-POSCAR

+program cell_POSCAR

 !announcement begin***********************************

 implicit none

@@ -9,6 +9,7 @@

 character(len=1) nonsense    !to contain something that will not be used

 character(len=2) position   !to read %

 character(len=2) element1,element2  

+character(len=20) :: fm

 !End announcement************************************

 !Begin reading data from "cell"****************************

@@ -48,13 +49,13 @@

 element1=element2

 if (m==1) then

   type(1)=1

-else if

+else

   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

+    else

       type(i)=k

       i=i+1

       element1=element2

@@ -68,22 +69,23 @@

 !Begin writing to "POSCAR"******************************

 open(unit=38,file="POSCAR",status="replace")

-write(38,10)System

+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

+write(fm,'(a,i0,a)') '(1x,',n,'(i3,2x))'

+write(38,fm)(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)

+!60 FORMAT(1X,n(I3,2X))

+100 FORMAT(1X,F18.15)

 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)

赞一下(2人)

回复此楼

10楼2011-05-04 22:43:20

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

相关版块跳转我要订阅楼主 Gina88 的主题更新

返回列表

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

[考研] 286求调剂 +6	lemonzzn 2026-03-16	10/500	2026-03-19 14:31 by lemonzzn
[考研] 324分 085600材料化工求调剂 +3	llllkkkhh 2026-03-18	3/150	2026-03-19 14:22 by houyaoxu
[考研] 346求调剂[0856] +3	WayneLim327 2026-03-16	6/300	2026-03-19 11:21 by WayneLim327
[考研] 0817调剂 +3	没有答案_ 2026-03-14	3/150	2026-03-19 09:51 by Xu de nuo
[考研] 材料工程专硕调剂 +5	204818@lcx 2026-03-17	6/300	2026-03-18 22:55 by 204818@lcx
[考研] 材料专业求调剂 +5	hanamiko 2026-03-18	5/250	2026-03-18 20:19 by 星空星月
[考研] 【同济软件】软件（085405）考研求调剂 +3	2026eternal 2026-03-18	3/150	2026-03-18 19:09 by 搏击518
[考研] 一志愿武理材料305分求调剂 +5	想上岸的鲤鱼 2026-03-18	6/300	2026-03-18 17:53 by 无际的草原
[考研] 302求调剂 +10	呼呼呼。。。。 2026-03-17	10/500	2026-03-18 12:45 by Linda Hu
[考研] 280求调剂 +6	咕噜晓晓 2026-03-18	7/350	2026-03-18 11:25 by 无际的草原
[考研] 303求调剂 +4	睿08 2026-03-17	6/300	2026-03-18 11:01 by Iveryant
[考研] 0703化学336分求调剂 +6	zbzihdhd 2026-03-15	7/350	2026-03-18 09:53 by zhukairuo
[考研] 283求调剂 +3	听风就是雨； 2026-03-16	3/150	2026-03-17 07:41 by 热情沙漠
[考研] 机械专硕325，寻找调剂院校 +3	y9999 2026-03-15	5/250	2026-03-16 19:58 by y9999
[考研] 一志愿211 0703方向310分求调剂 +3	努力奋斗112 2026-03-15	3/150	2026-03-16 16:44 by houyaoxu
[考研] 304求调剂 +3	曼殊2266 2026-03-14	3/150	2026-03-16 16:39 by houyaoxu
[考研] 277材料科学与工程080500求调剂 +3	自由煎饼果子 2026-03-16	3/150	2026-03-16 14:10 by 运气yunqi
[考研] 0703 物理化学调剂 +3	我可以上岸的对� 2026-03-13	5/250	2026-03-16 10:50 by 我可以上岸的对�
[考研] 0856专硕279求调剂 +5	加油加油！? 2026-03-15	5/250	2026-03-15 11:58 by 2020015
[考研] 266求调剂 +4	学员97LZgn 2026-03-13	4/200	2026-03-14 08:37 by zhukairuo