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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 写了一个fortran90的小程序，编译通不过，请大侠帮忙
北京石油化工学院2026年研究生招生接收调剂公告
601/6返回列表123456下一页
查看: 4087  |  回复: 59
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
本帖产生 3 个 程序强帖 ，点击这里进行查看

Gina88

木虫 (正式写手)

[求助] 写了一个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
回复此楼

» 猜你喜欢

» 本主题相关价值贴推荐，对您同样有帮助:
1楼 2011-05-04 17:51:43
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
回帖支持 ( 显示支持度最高的前 50 名 )

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
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

木虫 (正式写手)
这个是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

木虫 (正式写手)
那个笑脸：）是
冒号+右括号

那个红脸”）是
右括号
赞一下 回复此楼
3楼2011-05-04 17:56:30
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

Gina88

木虫 (正式写手)
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
赞一下 回复此楼
4楼2011-05-04 17:58:28
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

Gina88

木虫 (正式写手)
非常非常感谢大侠了！！！！！！
赞一下 回复此楼
5楼2011-05-04 17:59:54
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★ ★
余泽成(金币+2): 谢谢参与应助！ 2011-05-19 19:19:36
谨慎地怀疑你以前没有写过 Fortran 的程序，或者也没有认真地看过书，否则不应该出现字符串两端不加引号，if 后面不跟判断语句的情况，呵呵……

你贴出来的程序根本就不能进行编译（即出现语法错误），那么要别人怎么帮你……
赞一下(1人) 回复此楼
7楼2011-05-04 19:08:49
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

Gina88

木虫 (正式写手)
引用回帖:
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

至尊木虫 (职业作家)
引用回帖:
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

至尊木虫 (职业作家)

【答案】应助回帖

★ ★ ★ ★ ★
余泽成(金币+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 的主题更新
601/6返回列表123456下一页
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 081200-11408-276学硕求调剂 +6 崔wj 2026-03-26 6/300 2026-03-29 01:11 by hanserlol
[考研] 332求调剂 +6 蕉蕉123 2026-03-28 6/300 2026-03-29 00:37 by 544594351
[考研] 数一英一271专硕（085401）求调剂，可跨 +7 前行必有光 2026-03-28 8/400 2026-03-28 23:22 by 小木虫tim
[考研] 本科双非材料，跨考一志愿华电085801电气，283求调剂，任何专业都可以 +6 芝士雪baoo 2026-03-28 7/350 2026-03-28 21:40 by zhq0425
[考研] 316求调剂 +7 江辞666 2026-03-26 7/350 2026-03-28 21:28 by sanrepian
[考研] 312，生物学求调剂 +3 小译同学abc 2026-03-28 3/150 2026-03-28 15:32 by 落睿可思
[考研] 一志愿厦门大学化学学硕307求调剂 +10 y7czhao 2026-03-26 10/500 2026-03-28 14:23 by 唐沐儿
[考研] 求调剂 +6 芦lty 2026-03-25 7/350 2026-03-28 13:13 by 唐沐儿
[考研] 291求调剂 +15 hhhhxn.. 2026-03-23 21/1050 2026-03-28 11:26 by self2008
[考研] 085405 考的11408求各位老师带走 +3 Qiu学ing 2026-03-28 3/150 2026-03-28 09:19 by 乐呵呵的追梦人
[考研] 330一志愿中国海洋大学 化学工程 085602 有读博意愿 求调剂 +3 wywy.. 2026-03-27 4/200 2026-03-28 03:32 by fmesaito
[考研] 287求调剂 +10 land xuxu 2026-03-26 10/500 2026-03-27 15:33 by 帕尔马拉特
[考研] 复试调剂，一志愿南农083200食品科学与工程 +5 XQTJZ 2026-03-26 5/250 2026-03-27 14:49 by 狂炫麦当当
[考研] 312求调剂 +9 上岸吧ZJY 2026-03-22 13/650 2026-03-27 11:24 by sanrepian
[考研] 325求调剂 +5 李嘉图·S·路 2026-03-23 5/250 2026-03-27 00:42 by wxiongid
[考研] 342求调剂 +3 加油a李zs 2026-03-26 3/150 2026-03-27 00:29 by wxiongid
[考研] 294分080500材料科学与工程求调剂 +4 柳溪边 2026-03-26 4/200 2026-03-26 21:14 by XPU李庆
[考研] 总分322求生物学/生化与分子/生物信息学相关调剂 +5 星沉uu 2026-03-26 6/300 2026-03-26 19:02 by macy2011
[考研] 材料专硕 335 分求调剂 +4 拒绝冷暴力 2026-03-25 4/200 2026-03-25 18:45 by haxia
[考研] 0854人工智能方向招收调剂 +4 章小鱼567 2026-03-24 4/200 2026-03-25 13:29 by 2177681040
信息提示
关闭
请填处理意见
关闭