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

登录注册

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

24小时热门版块排行榜

北京石油化工学院2026年研究生招生接收调剂公告

返回列表

本帖产生 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人回复
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 的主题更新

返回列表

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

[考研] 085600调剂 +9	东照照照 2026-04-04	9/450	2026-04-05 13:44 by ujn_zhuj
[考研] 266分，一志愿电气工程，本科材料，求材料专业调剂 +5	哇呼哼呼哼 2026-04-02	6/300	2026-04-05 11:49 by 风雨无晴
[考研] 081700学硕，323分，一志愿中国海洋大学求调剂学校 +16	披星河 2026-04-04	16/800	2026-04-05 11:27 by 猪会飞
[考研] 283分求调剂 +9	试试看呗 2026-04-04	9/450	2026-04-05 10:27 by 果冻大王
[考研] 341求调剂 +3	学无止境，冲 2026-04-05	3/150	2026-04-05 09:40 by lbsjt
[考研] 333求调剂 +12	wfh030413@ 2026-04-03	13/650	2026-04-04 21:02 by jj987
[考研] 化学308分调剂 +23	你好明天你好 2026-03-30	24/1200	2026-04-04 18:29 by macy2011
[考研] 325求调剂 +4	春风不借意 2026-04-04	4/200	2026-04-04 14:46 by 湘农储能材料
[考研] 085701求调剂 +7	龚禹铭 2026-04-04	8/400	2026-04-04 13:49 by 小小树2024
[考研] 265求调剂 +20	梁梁校校 2026-04-01	21/1050	2026-04-04 00:38 by userper
[考研] 085601一志愿北理325分求调剂 +6	找调剂，， 2026-04-02	6/300	2026-04-03 22:20 by 柟�?
[考研] 286求调剂 +8	lim0922 2026-04-02	8/400	2026-04-03 20:19 by rzh123456
[考研] 085501一志愿天工大，机械专硕求调剂，跨材料 +3	33上 2026-04-03	3/150	2026-04-03 14:08 by 1753564080
[考研] 0705理学294求调剂 +3	成果成果cg5 2026-04-03	3/150	2026-04-03 14:04 by simons1972
[考研] 318求调剂 +3	笃行致远. 2026-03-31	4/200	2026-04-02 15:56 by Jaylen.
[考研] 一志愿厦门大学化学工程（专硕）-数二英二406分-求调剂 +5	厦大化工 2026-04-01	5/250	2026-04-02 10:03 by jp9609
[考研] 279求调剂 +6	学而思兮知 2026-04-01	6/300	2026-04-02 09:16 by vgtyfty
[考研] 材料调剂 +10	Eujd1 2026-03-31	11/550	2026-04-01 11:23 by ivanqyq
[考研] 085601 329分调剂 +6	yzsa12 2026-03-31	6/300	2026-03-31 15:23 by yanflower7133
[考研] 求调剂 +8	11ggg 2026-03-30	8/400	2026-03-31 13:56 by nanaliuyun