Fortran Coder

查看: 223|回复: 1

[文件读写] 子程序中进行文件中数据读写并进行求和求平均时出错

[复制链接]

1

帖子

1

主题

0

精华

新人

F 币
10 元
贡献
4 点
发表于 2019-5-29 12:08:58 | 显示全部楼层 |阅读模式
这是源码
[Fortran] 纯文本查看 复制代码
module typedef
type day1
integer a1,b1,c1,e1
end type
type day2
integer a2,b2,c2,e2
end type
type day3
integer a3,b3,c3,d4
end type
end module

program ex02
use typedef
implicit none
integer days,days2
type(day1),allocatable:: d(:)
type(day2)::s
type(day3),allocatable:: c(:)
type(day3) total
integer i,g,k,u,y,w,t,a3,b3,c3,d4
integer,parameter::fileid=10
integer,parameter::fileid2=10 
character(len=79)::filename
logical alive
integer error,no,num

write(*,*)"读取分析数据或输入数据。读取分析扣1,输入扣2"
read(*,*)w
if(w.eq.2)then
write(*,*)"写入旧文件还是新建文件,写入旧文件扣1,否则扣2"
read(*,*)g
if(g.eq.1)then
write(*,*)"filename:"
read(*,"(A79)")filename
inquire(file=filename,exist=alive)                        !检查要打开文件是否存在
   if(.not.alive)then
    write(*,*)trim(filename),"文件不存在"
    else
    open(unit=fileid,file=filename,status='old')           !读取原文件中数据
    do while(.true.)
    read(fileid,"(5xi2,/,5xi3,6xi3,6xi3,6xi3)",iostat=error)no,s
    if(error/=0)exit
    write(*,"('编号:'i2'日期:'i3' 水一:'i3' 水二:'i3' 水三:'i3)")no,s
    end do
    close(fileid)
    write(*,*)"输入最大编号"
    read(*,*)k
    write(*,*)"本次输入天数"
    read(*,*)days
    u=days+k
    allocate(d(u)) 
   open(unit=fileid,file=filename,position='append')      !在原文件中写入新数据
   do i=k+1,k+days
   write(*,"('请输入编号'i2'日期及其检测数据')")i
   read(*,*)d(i)%a1,d(I)%B1,d(I)%C1,d(I)%e1
   write(fileid,"('编号:'i2/'日期:'i3' 水一:'i3' 水二:'i3' 水三:'i3)")i,d(i)
   enddo
   close(fileid)
   endif
  else
   write(*,*)"filename:"                                   !创建新文件并输入数据
   read(*,"(A79)")filename
   write(*,*)"本次输入天数"
   read(*,*)days
   allocate(d(days))
   open(unit=fileid,file=filename,status='new')
   do i=1,days
   write(*,"('请输入编号'i2'日期及其检测数据')")i
   read(*,*)d(i)%a1,d(I)%B1,d(I)%C1,d(I)%e1
   write(fileid,"('编号'i2/'日期:'i3' 水一:'i3' 水二:'i3' 水三:'i3)")i,d(i)
   enddo
   close(fileid)
  endif
  write(*,*)"是否处理数据,是扣1,否扣2"
  read(*,*)y
   if(y.eq.2)then
    write(*,*)"程序即将关闭,辛苦了"
   else
    call f1(i,a3,b3,c3,d4,c,days,total,filename,no,s,error,alive)
   endif
else 
   call f1(i,a3,b3,c3,d4,c,days,total,filename,no,s,error,alive)
endif
end

subroutine f1(i,a3,b3,c3,d4,c,days,total,filename,no,s,error,alive)
use typedef
implicit none
type(day3) total
integer days
type(day2)::s
type(day3) c(days)
logical alive
integer i,a3,b3,c3,d4
integer,parameter::fileid2=20
character(len=79)::filename
integer error,no,num
write(*,*)"你要分析的filename:"  
read(*,"(A79)")filename
        inquire(file=filename,exist=alive)                        
   if(.not.alive)then
    write(*,*)trim(filename),"文件不存在"
    else
    open(unit=20,file=filename)
    do while(.true.)
    read(20,"(5xi2,/,5xi3,6xi3,6xi3,6xi3)",iostat=error)no,s
    if(error/=0)exit
    write(*,"('编号:'i2/'日期:'i3' 水一:'i3' 水二:'i3' 水三:'i3)")no,s
    end do

    write(*,*)"输入所需分析的天数"
    read(*,*) days
    total=day3(0,0,0,0)
    do i=1,days

        read(20,"(5xi2,/,5xi3,6xi3,6xi3,6xi3)")num,c(i)%d4,c(i)%a3,c(i)%b3,c(i)%c3
        total%d4=total%d4+c(i)%d4
        total%a3=total%a3+c(i)%a3
    total%b3=total%b3+c(i)%b3
    total%c3=total%c3+c(i)%c3
    enddo
        
    write(*,*),&
    real(total%a3)/real(days),&
real(total%b3)/real(days),&
real(total%c3)/real(days)
stop
endif
end 

这是TXT中的数据
编号 1
日期:  1 水一:  2 水二:  3 水三:  4
编号 2
日期:  4 水一:  5 水二:  6 水三:  7
编号: 4
日期:  3 水一:  4 水二:  4 水三:  4
编号: 5
日期:  5 水一:  3 水二:  3 水三:  3

运行的结果已上传

确定是
read(20,"(5xi2,/,5xi3,6xi3,6xi3,6xi3)")num,c(i)%d4,c(i)%a3,c(i)%b3,c(i)%c3
        total%d4=total%d4+c(i)%d4
        total%a3=total%a3+c(i)%a3
    total%b3=total%b3+c(i)%b3
    total%c3=total%c3+c(i)%c3
    enddo
的问题,怎么改





_A4)3%BOJ6053TXDU_RPIUS.png
回复

使用道具 举报

40

帖子

0

主题

0

精华

熟手

F 币
304 元
贡献
128 点

规矩勋章元老勋章新人勋章

发表于 2019-5-29 16:50:24 | 显示全部楼层
问题1
子程序 f1 中,你要读2遍文件,需要读完一遍,返回文件头部。
如下:
rewind(20) !//返回文件头部
  do i=1,days
      read(20,"(5xi2,/,5xi3,6xi3,6xi3,6xi3)")num,c(i)%d4,c(i)%a3,c(i)%b3,c(i)%c3

问题2
主程序中 type(day3),allocatable:: c(:) 尚未分配。
所以第二遍读取到 c 里面就出错了。
天之道,损有余而补不足
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

QQ|捐赠本站|Archiver|关于我们 About Us|群聊|Fcode

GMT+8, 2019-9-19 14:58

Powered by Discuz! X3.2

© 2001-2017 Comsenz Inc.

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