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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 写了一个fortran90的小程序，编译通不过，请大侠帮忙
北京石油化工学院2026年研究生招生接收调剂公告
54/1返回列表
查看: 4083  |  回复: 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的回帖

Gina88

木虫 (正式写手)
引用回帖:
Originally posted by snoopyzhao at 2011-05-08 17:37:30:
你最好还是把运行程序所有的代码+数据文件打包放在附件里吧，要不然，别人也没有办法测试啊，仅仅靠看的功力还是不够的……

上帖中，CHGCAR1和CHGCAR2可能有错误，这里再发一次。
谢谢您了！

write(*,*)"number of CHGCAR files2 or 3?)"
read(*,*)filenum
这里可以输入2
赞一下 回复此楼
36楼2011-05-09 00:15:39
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 60 个回答

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的回帖
查看全部 60 个回答
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 289求调剂 +11 新时代材料 2026-03-27 11/550 2026-03-28 18:09 by YK。。
[考研] 22408 359分调剂 +3 Qshers 2026-03-27 4/200 2026-03-28 16:45 by Qshers
[考研] 085602 化工专硕 338分 求调剂 +12 路痴小琪 2026-03-27 12/600 2026-03-28 15:41 by L135790
[考研] 本科双非材料，跨考一志愿华电085801电气，283求调剂，任何专业都可以 +5 芝士雪baoo 2026-03-28 6/300 2026-03-28 15:25 by 1018329917
[考研] 一志愿厦门大学化学学硕307求调剂 +10 y7czhao 2026-03-26 10/500 2026-03-28 14:23 by 唐沐儿
[考研] 347求调剂 +3 山顶见α 2026-03-25 3/150 2026-03-28 14:13 by 唐沐儿
[考研] 0703一志愿9，初试成绩：338，四六级已过，有科研经历，求调剂！ +4 Zuhui0306 2026-03-25 4/200 2026-03-28 13:07 by 唐沐儿
[考研] 292求调剂 +14 鹅鹅鹅额额额额� 2026-03-25 15/750 2026-03-28 08:45 by WYUMater
[考研] 340求调剂 +5 jhx777 2026-03-27 5/250 2026-03-28 04:18 by fmesaito
[考研] 330一志愿中国海洋大学 化学工程 085602 有读博意愿 求调剂 +3 wywy.. 2026-03-27 4/200 2026-03-28 03:32 by fmesaito
[考研] 275求调剂 +10 jjjjjjjjjjl 2026-03-27 10/500 2026-03-27 23:47 by barnett0632
[考研] 351求调剂 +4 麦克阿磊 2026-03-24 4/200 2026-03-27 00:32 by wxiongid
[考研] 一志愿北化求调剂 +3 Jsman 2026-03-22 3/150 2026-03-26 21:06 by ajpv风雷
[考研] 289求调剂 +17 硕星赴 2026-03-23 17/850 2026-03-26 16:18 by 不吃魚的貓
[考研] 0854AI CV方向招收调剂 +4 章小鱼567 2026-03-23 4/200 2026-03-25 17:04 by CoderLoser
[考研] 085404电子信息284分求调剂 +4 13659058978 2026-03-24 4/200 2026-03-24 12:15 by syl20081243
[考研] 341求调剂(一志愿湖南大学070300) +5 番茄头--- 2026-03-22 6/300 2026-03-23 23:45 by Txy@872106
[考研] 361求调剂 +3 Glack 2026-03-22 3/150 2026-03-23 22:03 by fuyu_
[考研] 接收2026硕士调剂(学硕+专硕) +4 allen-yin 2026-03-23 6/300 2026-03-23 15:04 by 汪！？！
[考研] 一志愿东华大学化学070300，求调剂 +7 2117205181 2026-03-21 8/400 2026-03-22 22:55 by chixmc
信息提示
关闭
请填处理意见
关闭