Fortran Coder

查看: 8010|回复: 4
打印 上一主题 下一主题

[输入输出] 求助:求精简一个自己写的格式化输出小程序

[复制链接]

11

帖子

2

主题

0

精华

入门

绿手

F 币
83 元
贡献
48 点
跳转到指定楼层
楼主
发表于 2016-6-13 14:15:47 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
想要实现的功能如下:
输入文件input.txt内容如下
Trajectory MaxJob                          I                4
Traj num       1 Geometries                R   N=          4
a1      a2      a3      a4
Traj num       2 Geometries                R   N=          3
b1      b2      b3
Traj num       3 Geometries                R   N=          6
c1      c2      c3      c4      c5
c6
Traj num       4 Geometries                R   N=          1
d1

输入文件input.txt内容如下
         1  a1        b1        c1        d1      

         2  a2        b2        c2               

         3  a3        b3        c3               

         4  a4                  c4               

         5                      c5               

         6                      c6               


我的fortran程序段fortran90.f90内容如下
[Fortran] 纯文本查看 复制代码
module util
contains
subroutine loclabel(fileid,label,ifound,irewind)
integer fileid,error
integer,optional :: ifound,irewind
character(len=80) :: c80
CHARACTER(LEN=*) label
if ((.not.present(irewind)).or.(present(irewind).and.irewind==1)) rewind(fileid)
do while(.true.)
 read(fileid,"(a80)",iostat=ierror) c80
 if (index(c80,label)/=0) then
  backspace(fileid)
  if (present(ifound)) ifound=1 
  return
 end if
 if (ierror/=0) exit
end do
if (present(ifound)) ifound=0
end subroutine
end module

program formout
!implicit none
use util
character infilename*200,outfilename*200,ord*8,findtraj*27
integer  ntraj,nmax,i,ntmp,j,k,l
logical alive
integer(4),allocatable :: nnum(:)
character(8),allocatable :: bond(:,:)
write(*,*) "Input the .txt filename to be loaded"
do while(.true.)
 read(*,"(a)") infilename  
 inquire(file=infilename,exist=alive)   
 if (alive) exit
 write(*,*) "Cannot found this file, input again"
end do
open(10,file=infilename,status="old")
call loclabel(10,'Trajectory MaxJob')
read(10,"(49x,i12)") ntraj 
write(*,"('Number of trajs:',i10)") ntraj
allocate(nnum(ntraj))
nnum=0
do i=1,ntraj
write(findtraj,"(a,i8,a)") 'Traj num',i,' Geometries'      
call loclabel(10,findtraj,ifound)
read(10,"(49x,i12)") ntmp
nnum(i)=ntmp
end do
nmax=MaxVal(nnum)
write(*,"('The max step in some traj :',i10)") nmax
close(10)

allocate(bond(nmax,(ntraj+1)))
bond='        '

do i=1,nmax
write(ord,"(i8)") i
bond(i,1)=ord
end do

l=1
do while (l <= ntraj)
open(10,file=infilename,status="old")
write(findtraj,"(a,i8,a)") 'Traj num',l,' Geometries'   
call loclabel(10,findtraj,ifound) 
read(10,"(49x,i12)") ntmp
l=l+1
!REWIND(10)
!nnum(i)

do k=1,ntmp
read(10,'(a8,$)') bond(k,l)  !为了不换行
end do
write(*,*) bond
end do

write(*,*) "aaaaa"
write(*,*) bond

close(10)
print*, "4.0"
write(*,*) "Input the .txt filename to be outputted"
read(*,"(a)") outfilename
open(10,file=outfilename,status="replace")
do i=1,nmax
do j=1,(ntraj+1)
write(10,'(a10,$)') bond(i,j)
end do
write(10,"(/)")
end do
close(10)

    pause
    
end program formout



分享到:  微信微信
收藏收藏1 点赞点赞 点踩点踩

954

帖子

0

主题

0

精华

大师

F 币
184 元
贡献
75 点

规矩勋章元老勋章新人勋章水王勋章热心勋章

QQ
沙发
发表于 2016-6-14 09:13:16 | 只看该作者
看了一遍代码,感觉没有什么值得精简的。
也编译了一下,没有问题。
另外,没搞明白 input.txt 到底应该是什么内容。所以也没运行

11

帖子

2

主题

0

精华

入门

绿手

F 币
83 元
贡献
48 点
板凳
 楼主| 发表于 2016-6-14 14:27:05 | 只看该作者
vvt 发表于 2016-6-14 09:13
看了一遍代码,感觉没有什么值得精简的。
也编译了一下,没有问题。
另外,没搞明白 input.txt 到底应该是 ...

谢谢回复。
input.txt内容已在帖子开头给出来了。

1963

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1357 元
贡献
574 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

地板
发表于 2016-6-17 08:23:13 | 只看该作者
你给了两段 input.txt 的内容。到底是第一段,还是第二段?还是两端的组合?

或者你可以直接上传该文件。

11

帖子

2

主题

0

精华

入门

绿手

F 币
83 元
贡献
48 点
5#
 楼主| 发表于 2016-6-17 11:38:09 | 只看该作者
本帖最后由 一声叹息010 于 2016-6-17 12:05 编辑
fcode 发表于 2016-6-17 08:23
你给了两段 input.txt 的内容。到底是第一段,还是第二段?还是两端的组合?

或者你可以直接上传该文件。 ...

是我写错了,第二个input.txt其实应该是output.txt,文件已经上传
我自己减了减,还是觉得啰嗦


subroutine loclabel(fileid,label)
integer fileid,ierror
character(80) c80
CHARACTER(LEN=*) label
do while(.true.)
read(fileid,"(a80)",iostat=ierror) c80
if (index(c80,label)/=0) then
  backspace(fileid)
        return
    end if
if (ierror/=0) exit
end do
end subroutine

program formatting
implicit none
character infilename*200,outfilename*200,findtraj*27
integer  ntraj,nmax,ntmp,i,j
logical alive
integer(4),allocatable :: nnum(:)
character(8),allocatable :: bond(:,:)
write(*,*) "Input the .txt filename to be loaded"
do while(.true.)
read(*,"(a)") infilename
inquire(file=infilename,exist=alive)
if (alive) exit
write(*,*) "Cannot found this file, input again"
end do
open(10,file=infilename,status="old")
call loclabel(10,'Trajectory MaxJob')
read(10,"(49x,i12)") ntraj
write(*,"('Number of trajs:',i10)") ntraj
allocate (nnum(ntraj))
do i=1,ntraj
    write(findtraj,"(a,i8,a)") 'Traj num',i,' Geometries'      
    call loclabel(10,findtraj)
    read(10,"(49x,i12)") ntmp
    nnum(i)=ntmp
end do
nmax=MaxVal(nnum)
write(*,"('The max-step :',i10)") nmax
allocate (bond(ntraj,nmax))
bond='        '
rewind(10)
i=1
do while (i <= ntraj)
    write(findtraj,"(a,i8,a)") 'Traj num',i,' Geometries'   
    call loclabel(10,findtraj)
    read(10,"(49x,i12)") ntmp
    do j=1,ntmp
        read(10,'(a8,$)') bond(i,j)
    end do
    i=i+1
end do
close(10)

write(*,*) "Input the .txt filename to be outputted"
read(*,"(a)") outfilename
open(11,file=outfilename,status="replace")
do j=1,nmax
    write(11,"(i4,'  ',$)") j
    do i=1,ntraj
        write(11,"(a8,$)") bond(i,j)
    end do
    write(11,"(/)")   
end do
close(11)
end program formatting

input.txt

417 Bytes, 下载次数: 3

output.txt

252 Bytes, 下载次数: 1

test22.f90

1.62 KB, 下载次数: 2

您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

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

GMT+8, 2024-5-2 11:16

Powered by Tencent X3.4

© 2013-2024 Tencent

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