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

24小时热门版块排行榜    

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

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

智能机器人

Robot (super robot)

我们都爱小木虫

找到一些相关的精华帖子，希望有用哦~

科研从小木虫开始，人人为我，我为人人

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

Gina88(金币+5): 2011-05-05 09:42:06
余泽成(程序强帖+1): 2011-05-19 19:20:22
再贴个完整的程序吧，呵呵……
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
character(len=20) :: filename
!End announcement************************************

!Begin reading data from "cell"****************************
!call getarg(1,filename)
call GET_COMMAND_ARGUMENT(1,filename)
open(unit=18,file=filename,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=filename,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,*) filename(1:len(trim(filename))-5)
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
赞一下(1人) 回复此楼
16楼2011-05-05 09:19:38
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

Gina88(金币+2): 2011-05-05 11:28:04
余泽成(程序强帖+1): 2011-05-05 18:28:00
引用回帖:
Originally posted by Gina88 at 2011-05-05 10:30:36:
这个好像编译通不过啊，他说没有定义GET_COMMAND_ARGUMENT。
另外文件名没有从众多的文件中筛选后缀名为cell的文件啊。

谢谢大侠了，你真是帮了我很大很大的忙，呵呵：）

我在 diff 中说了，GET_COMMAND_ARGUMENT 是 Fortran 2003 标准中的，如果你的编译器还不支持的话，就用 getarg，就是前面的那句。

至于从文件名中筛选，我前面的回复中也说了，你最好借助于操作系统提供的功能，如果是 Linux，下面的脚本应该是可行的……
CODE:
for i in `ls *.cell`; do
    ./a.exe $i;
done

如果是 Windows 的操作系统，应该也是类似的，不过我没有编写 .bat 的经验……

需要说明的是，你的 POSCAR 文件内容会被替代的……
赞一下(1人) 回复此楼
18楼2011-05-05 10:52:28
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 Gina88 的主题更新
31/1返回列表
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 070305高分子化学与物理 304分求调剂 +7 c297914 2026-03-28 7/350 2026-03-29 01:17 by 544594351
[考研] 一志愿哈尔滨工业大学材料与化工方向336分 +9 辰沐5211314 2026-03-26 9/450 2026-03-29 01:12 by 我是小康
[考研] 0703 化学 求调剂，一志愿山东大学 342 分 +4 Shern—- 2026-03-28 4/200 2026-03-29 00:47 by 544594351
[考研] 332求调剂 +4 @MZB382400 2026-03-28 4/200 2026-03-28 21:02 by 唐沐儿
[考研] 本科新能源科学与工程，一志愿华理能动285求调剂 +7 AZMK 2026-03-28 11/550 2026-03-28 21:01 by xxxsssccc
[考研] 283求调剂 +7 A child 2026-03-28 7/350 2026-03-28 12:05 by zllcz
[考研] 0856，材料与化工321分求调剂 +12 大馋小子 2026-03-27 13/650 2026-03-28 10:56 by self2008
[考研] 085404求调剂，总分309，本科经历较为丰富 +4 来财aa 2026-03-25 4/200 2026-03-28 07:41 by 棒棒球手
[考研] 085601 材料工程 313分 求调剂 +5 Ong3 2026-03-27 5/250 2026-03-27 12:24 by goldfish51
[考研] 324求调剂 +5 hanamiko 2026-03-26 5/250 2026-03-27 10:33 by wangjy2002
[考研] 286求调剂 +4 lim0922 2026-03-26 4/200 2026-03-27 10:28 by guoweigw
[考研] 材料学硕，求调剂 6+5 糖葫芦888ll 2026-03-22 10/500 2026-03-27 08:18 by hypershenger
[考研] 求调剂，一志愿 南京航空航天大学大学 ，080500材料科学与工程学硕 +4 @taotao 2026-03-26 5/250 2026-03-27 08:10 by hypershenger
[考研] 324求调剂 +8 hanamiko 2026-03-26 10/500 2026-03-27 08:06 by hypershenger
[考研] 317求调剂 +7 蛋黄咸肉粽 2026-03-26 7/350 2026-03-27 02:29 by fmesaito
[考研] 086000生物与医药292求调剂 +6 小小陈小小 2026-03-22 9/450 2026-03-26 15:58 by dick_runner
[考研] 303求调剂 +6 蓝山月 2026-03-25 6/300 2026-03-25 22:47 by 418490947
[考研] 一志愿吉大化学322求调剂 +4 17501029541 2026-03-23 6/300 2026-03-24 10:21 by 戴围脖的小蚊子
[考研] 344求调剂 +3 desto 2026-03-24 3/150 2026-03-24 10:09 by 搏击518
[考研] 一志愿重庆大学085700资源与环境，总分308求调剂 +7 墨墨漠 2026-03-23 8/400 2026-03-23 20:36 by Creta
信息提示
关闭
请填处理意见
关闭