Fortran Coder

标题: 有规律的文件名，不用许多通道号而将信息读取出 [打印本页]
作者: 978142355    时间: 2015-11-17 20:53
标题: 有规律的文件名，不用许多通道号而将信息读取出
手头存在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试一试 ...
作者: pasuka    时间: 2015-11-18 08:43
本帖最后由 pasuka 于 2015-11-18 09:16 编辑

文件头好像就不太对
给段Python代码仅供参考，能够看明白的话，网上再找找C或C++的代码，F直接调用即可
Python Code
作者: li913    时间: 2015-11-18 09:08
群共享有 《fortran批量处理文件》
作者: 珊瑚虫    时间: 2015-11-18 10:20
看了一下你得程序发现了两个问题：
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  

        
作者: 978142355    时间: 2015-11-18 15:11
珊瑚虫 发表于 2015-11-18 10:20
看了一下你得程序发现了两个问题：
1.你得程序中没有判断有多少个文件，你在问题表述中说 “有一系列文件要 ...


暂时功能未完全实现，等实现了，我将代码粘贴出来，方便以后的人。先谢谢你提供的思路。
作者: 978142355    时间: 2015-11-23 12:24
本帖最后由 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

      





欢迎光临 Fortran Coder (http://bbs.fcode.cn/) Powered by Discuz! X3.2