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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 写了一个fortran90的小程序，编译通不过，请大侠帮忙
51/1返回列表
查看: 4060  |  回复: 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的回帖

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的回帖
查看全部 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 个回答
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 070300化学319求调剂 +4 锦鲤0909 2026-03-17 4/200 2026-03-17 18:21 by 重科小霸王
[考研] 材料与化工专硕调剂 +5 heming3743 2026-03-16 5/250 2026-03-17 14:03 by 勇敢太监王公公
[考博] 26申博 +4 八旬速览 2026-03-16 4/200 2026-03-17 13:00 by 轻松不少随
[基金申请] 国自科面上基金字体 +6 iwuli 2026-03-12 7/350 2026-03-16 21:18 by sculhf
[考研] 318求调剂 +3 Yanyali 2026-03-15 3/150 2026-03-16 16:41 by houyaoxu
[考研] 0703化学调剂 +6 妮妮ninicgb 2026-03-15 9/450 2026-03-16 16:40 by houyaoxu
[考研] 285求调剂 +6 ytter 2026-03-12 6/300 2026-03-16 15:05 by njzyff
[考研] 材料与化工一志愿南昌大学327求调剂推荐 +7 Ncdx123456 2026-03-13 8/400 2026-03-16 12:15 by karry wen
[考研] 0856专硕279求调剂 +5 加油加油！? 2026-03-15 5/250 2026-03-15 11:58 by 2020015
[考研] 297一志愿上交085600求调剂 +5 指尖八千里 2026-03-14 5/250 2026-03-14 17:26 by a不易
[考研] 265求调剂 +4 威化饼07 2026-03-12 4/200 2026-03-14 17:23 by userper
[考研] 341求调剂 +4 番茄头--- 2026-03-10 4/200 2026-03-13 23:12 by JourneyLucky
[考研] 材料工程调剂 +9 咪咪空空 2026-03-12 9/450 2026-03-13 22:05 by 星空星月
[考研] 工科，求调剂 +3 我887 2026-03-11 3/150 2026-03-13 21:39 by JourneyLucky
[考研] 301求调剂 +6 Liyouyumairs 2026-03-11 6/300 2026-03-13 20:11 by JourneyLucky
[考研] 土木第一志愿276求调剂，科研和技能十分丰富，求新兴方向的导师收留 +3 土木小天才 2026-03-12 3/150 2026-03-13 15:01 by JourneyLucky
[考研] 材料301分求调剂 +5 Liyouyumairs 2026-03-12 5/250 2026-03-13 14:42 by JourneyLucky
[考研] 270求调剂 085600材料与化工专硕 +3 YXCT 2026-03-11 3/150 2026-03-13 10:13 by houyaoxu
[考博] 福州大学杨黄浩课题组招收2026年专业学位博士研究生，2026.03.20截止 +3 Xiangyu_ou 2026-03-12 3/150 2026-03-13 09:36 by duanwu655
[考研] 333求调剂 +3 152697 2026-03-12 4/200 2026-03-13 07:08 by Iveryant
信息提示
关闭
请填处理意见
关闭