Fortran Coder

查看: 8261|回复: 5
打印 上一主题 下一主题

[文件读写] 有规律的文件名,不用许多通道号而将信息读取出

[复制链接]

40

帖子

11

主题

0

精华

大宗师

F 币
4252 元
贡献
1857 点

规矩勋章

QQ
跳转到指定楼层
楼主
发表于 2015-11-17 20:53:49 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
手头存在1.xyz, 1.xyz_1, 1.xyz_2, 1.xyz_3, 1.xyz_4……1.xyz_10,想将它们统统可以转化为1.gjf,我自己也编了代码,可是怎么也运行不通,出现问题,想让各位老师帮忙看一看,修改修改,是不是我的思维又混乱了。
[Fortran] 纯文本查看 复制代码
program xyzgjf !xyz转成gjf
    implicit none
    integer::i,j,k,l,base,ierr
    character(len=20)::name,name1,a(1),b,c,d
    real(kind=kind(0.0d0))::x,y,z
    b='%chk=name.chk'    
    c='#p B3LYP/6-31G opt '
    d='Title Card Required' !b,c,d 是写在gjf的前几行的
    k=0
    l=1
    base=12
    write(*,*)'Input the name of file:'
    read(*,*) name
    
    name1=trim(name)
    if (i>=1) then
        Open(base+i,file='name1.xyz_i')
        Open(11,file='name1.gjf')
    Do j=1,1
        read(base+i,*) 
    End Do
    else 
        Open(12,file='name1.xyz') 
        Open(11,file='name1.gjf')
    Do j=1,1
        read(12,*) 
    End Do
    End If

    write(11,"(a20,/,a20,/,/,a20,/,/,I1,1x,I1 )") b,c,d,k,l
    
    Do
        If (i>=1) then
            Read(base+i,'(8x,a1,2x,f12.6,f12.6,f12.6)',Iostat=ierr) a(1),x,y,z
            If(ierr==0) then
                write(11,'(1x,a,14x,f12.6,2x,f12.6,2x,f12.6)') trim(a(1)),x,y,z
            End If
        else
            Read(12,'(8x,a1,2x,f12.6,f12.6,f12.6)',Iostat=ierr) a(1),x,y,z 
            If(ierr==0) then
                write(11,'(1x,a,14x,f12.6,2x,f12.6,2x,f12.6)') trim(a(1)),x,y,z
            End If
        End If
        If (ierr/=0) exit
    End Do
    Close(11)
    Close(12)
    Close(base+i)
End  
        

1crn.xyz

42.19 KB, 下载次数: 0

1crn.xyz_1等文件传不上去,麻烦各位老师将此文件测试后,再改为1crn.xyz_1试一试 ...

分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩
where is dream,where is home

490

帖子

4

主题

0

精华

大宗师

F 币
3298 元
贡献
1948 点

水王勋章元老勋章热心勋章

沙发
发表于 2015-11-18 08:43:14 | 只看该作者
本帖最后由 pasuka 于 2015-11-18 09:16 编辑

文件头好像就不太对
给段Python代码仅供参考,能够看明白的话,网上再找找C或C++的代码,F直接调用即可
Python Code

835

帖子

2

主题

0

精华

大宗师

F 币
3926 元
贡献
2334 点
板凳
发表于 2015-11-18 09:08:20 | 只看该作者
群共享有 《fortran批量处理文件》

135

帖子

15

主题

0

精华

版主

F 币
1159 元
贡献
637 点

爱心勋章管理勋章

地板
发表于 2015-11-18 10:20:44 | 只看该作者
看了一下你得程序发现了两个问题:
1.你得程序中没有判断有多少个文件,你在问题表述中说 “有一系列文件要读”,但是你得程序只读一个,且控制参数 “i”(如16行)没有设定输入,或者初始化,一次只能处理一个文件
2.在文件名的处理上,尚未分清楚字符串和变量的关系。
第一个问题是你程序逻辑的问题,请自行修改,而第二个问题的建议性修改如下
[Fortran] 纯文本查看 复制代码
program xyzgjf !xyz转成gjf
    implicit none
    integer::i,j,k,l,base,ierr
    character(len=20)::a(1),b,c,d
    character(len=100)::name,name1,name2
    real(kind=kind(0.0d0))::x,y,z
    b='%chk=name.chk'    
    c='#p B3LYP/6-31G opt '
    d='Title Card Required' !b,c,d 是写在gjf的前几行的
    k=0
    l=1
    base=12
    write(*,*)'Input the name of file:'
    read(*,*) name
    i=3
    if (i>=1) then
        write(name2,*)i
        name1=trim(adjustl(name))//'.xyz_'//trim(adjustl(name2))
        Open(base+i,file=trim(adjustl(name1)))
        name1=trim(adjustl(name))//'.gjf'
        Open(11,file=trim(adjustl(name1)))
    Do j=1,1
        read(base+i,*) 
    End Do
    else 
        name1=trim(adjustl(name))//'.xyz'
        Open(12,file=trim(adjustl(name1))) 
        name1=trim(adjustl(name))//'.gjf'
        Open(11,file=trim(adjustl(name1)))
    Do j=1,1
        read(12,*) 
    End Do
    End If

    write(11,"(a20,/,a20,/,/,a20,/,/,I1,1x,I1 )") b,c,d,k,l
    
    Do
        If (i>=1) then
            Read(base+i,'(8x,a1,2x,f12.6,f12.6,f12.6)',Iostat=ierr) a(1),x,y,z
            If(ierr==0) then
                write(11,'(1x,a,14x,f12.6,2x,f12.6,2x,f12.6)') trim(a(1)),x,y,z
            End If
        else
            Read(12,'(8x,a1,2x,f12.6,f12.6,f12.6)',Iostat=ierr) a(1),x,y,z 
            If(ierr==0) then
                write(11,'(1x,a,14x,f12.6,2x,f12.6,2x,f12.6)') trim(a(1)),x,y,z
            End If
        End If
        If (ierr/=0) exit
    End Do
    Close(11)
    Close(12)
    Close(base+i)
End  
        

40

帖子

11

主题

0

精华

大宗师

F 币
4252 元
贡献
1857 点

规矩勋章

QQ
5#
 楼主| 发表于 2015-11-18 15:11:52 | 只看该作者
珊瑚虫 发表于 2015-11-18 10:20
看了一下你得程序发现了两个问题:
1.你得程序中没有判断有多少个文件,你在问题表述中说 “有一系列文件要 ...


暂时功能未完全实现,等实现了,我将代码粘贴出来,方便以后的人。先谢谢你提供的思路。
where is dream,where is home

40

帖子

11

主题

0

精华

大宗师

F 币
4252 元
贡献
1857 点

规矩勋章

QQ
6#
 楼主| 发表于 2015-11-23 12:24:02 | 只看该作者
本帖最后由 978142355 于 2015-11-23 12:25 编辑
978142355 发表于 2015-11-18 15:11
暂时功能未完全实现,等实现了,我将代码粘贴出来,方便以后的人。先谢谢你提供的思路。 ...

程序功能成功实现,感谢群里以及论坛里帮助的人。
[Fortran] 纯文本查看 复制代码
Program xyzgjf !xyz converts to gjf
    Implicit none
    Integer::i,j,ierr,k,l,m
    Character(len=20)::a(1),name,name2,b,c,d
    Real(8)::x,y,z  
    b='%chk=name.chk'
    c='#p B3LYP/6-31G opt '
    d='Title Card Required'
    k=0
    l=1
    write(*,*) 'Input the name of coordination(e.g.1crn or 1crn.xyz_n):'
    Read(*,*) name

    name2=trim(name(:index(name,'.')))//'gjf'
    Open(12,file=name)
    Open(13,file=name2)
    
    Do i=1,1
        read(12,*) 
    End Do
    
    write(13,"(a20,/,a20,/,/,a20,/,/,I1,1x,I1 )") b,c,d,k,l

    Do 

      Read(12,'(8x,a1,2x,f12.6,f12.6,f12.6)',Iostat=ierr) a(1),x,y,z
      If(ierr==0) then
        
      write(13,'(1x,a,14x,f12.6,2x,f12.6,2x,f12.6)') trim(a(1)),x,y,z
      End If
      if (ierr/=0) exit
    End Do
    Close(12)
    Close(13)
End
      

where is dream,where is home
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-11-25 02:50

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表