Fortran Coder

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

[文件读写] 关于多个文件名匹配后批量输出

[复制链接]

67

帖子

16

主题

0

精华

专家

F 币
275 元
贡献
201 点
跳转到指定楼层
楼主
发表于 2017-8-23 15:23:07 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 wxy 于 2017-8-23 18:43 编辑

我想把读入的文件根据year(i),month(i),day(I)三列分别输出到对应的TXT文件中,输出文件名也是根据这三列命名的,但是匹配输出时是每隔一个文件输出一次(像1,3,5),(本来应该是每日数据分别输出到对应日文件下),不知道是哪里出错
[Fortran] 纯文本查看 复制代码
Integer Function daysinyear(year, month)
  Integer :: year, month
  Integer :: daysinmonth(12) = [ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ]
  If (((mod(year,4)==0) .And. (mod(year,100)/=0)) .Or. (mod(year,400)==0)) Then
    daysinmonth(2) = 29
  Else
    daysinmonth(2) = 28
  End If
  daysinyear = daysinmonth(month)
End Function daysinyear

Program weather
  Implicit None
  Integer l, i, j, m, daysinyear, k, a
  Integer, Allocatable :: site(:), lat(:), lon(:), year(:), month(:), day(:)
  real, Allocatable :: rain(:)
  Integer :: h, pre1, pre2
  Character (45) :: filename = 'SURF_CLI_CHN_MUL_DAY-PRE-13011-123456.txt'
  Character (8) :: outfile = '12345678', f = '12345678'
!  character(6)::filename1='123456.txt'
  Character (Len=20) :: line
!================================================================================================
!批量读入文件
!================================================================================================
  Do l = 2010, 2015 !内部文件读写,将filename 第8-11 字符换为相应年份
    Do j = 1, 12
      Write (filename(32:37), '(i6)') l*100 + j
      Open (11, File='D:\气象数据\降水\'//filename, Action='read')
!=================================================================================================
!创建输出文件
!=================================================================================================
      Do k = 1, daysinyear(l, j)
        Write (outfile(1:8), '(i8)') l*10000 + j*100 + k
!  print *,outfile
        Open (15, File='D:\气象数据\pre\'//outfile//'.txt')

!===============================================================================================
! 获取文件行数
!===============================================================================================
        a = 0
        Do
          Read (11, *, End=100) line
          a = a + 1
        End Do
        100 m = a !//跳过第一行
        Rewind (11)

!=================================================================================================
        Allocate (site(m), lat(m), lon(m), year(m), month(m), day(m), rain(m))
!=================================================================================================
        Do i = 1, m
          Read (11, *) site(i), lat(i), lon(i), h, year(i), month(i), day(i), pre1, pre2, rain(i)
          rain(i)=rain(i)/10


          Write (f(1:8), '(i8)') year(i)*10000 + month(i)*100 + day(i)

!print *,f
          If (rain(i)==3270) Then
            rain(i) = 0
          End If
!print *, site(i),lat(i),lon(i) , year(i) , month(i) , day(i) , rain(i)

       ! print *,site(i), lat(i), lon(i), year(i), month(i), day(i),rain(i)


!=================================================================================================



!==================================================================================

        End Do
        Do i = 1, m
        if(l*10000 + j*100 + k.eq.year(i)*10000 + month(i)*100 + day(i))then
        Write (15, "(i5,2x,i4,2x,i5,2x,i4,2x,i2,2x,i2,2x,f5.2)") site(i), lat(i), lon(i), year(i), month(i), day(i), rain(i)
        print *,site(i), lat(i), lon(i), year(i), month(i), day(i),rain(i)
        end if
        end do
        Deallocate (site, lat, lon, year, month, day, rain)
      End Do
    End Do

  End Do


  Close (11)

End Program weather

QQ截图20170823151828.png (11.54 KB, 下载次数: 209)

QQ截图20170823151828.png

QQ截图20170823161300.png (42.77 KB, 下载次数: 209)

QQ截图20170823161300.png

QQ截图20170823151842.png (25.09 KB, 下载次数: 218)

QQ截图20170823151842.png
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

130

帖子

10

主题

0

精华

大师

F 币
617 元
贡献
372 点

贡献勋章管理勋章帅哥勋章元老勋章星光勋章规矩勋章

沙发
发表于 2017-8-23 21:24:00 | 只看该作者
請參考看看:
[Fortran] 纯文本查看 复制代码
Program weather
  Implicit None

  Integer l, i, j, m, daysinyear, k
  Integer, Allocatable :: site(:), lat(:), lon(:), year(:), month(:), day(:)
  real, Allocatable :: rain(:)
  Integer :: h, pre1, pre2, ier
  Character (45) :: filename = 'SURF_CLI_CHN_MUL_DAY-PRE-13011-123456.txt'
  Character (8) :: outfile = '12345678'
  Character (Len=20) :: line

  !=====================================

  DO l = 2010, 2015
  DO j = 1, 12
    WRITE(filename(32:37),'(i6)') l*100+j
    OPEN( UNIT=11, FILE='D:\气象?据\降水\'//filename, ACTION='READ' )

    m = 0
    DO
      READ(11,*,IOSTAT=ier) line
      IF( ier == -1 ) EXIT ! end-of-file
      m = m + 1
    END DO
    ALLOCATE (site(m), lat(m), lon(m), year(m), month(m), day(m), rain(m))

    REWIND(11)
    DO i = 1, m
      READ(11,*) site(i), lat(i), lon(i), h, year(i), month(i), day(i), pre1, pre2, rain(i)
      rain(i) = rain(i)/10.0
      IF( rain(i) == 3270.0 ) rain(i) = 0.0
    END DO
    CLOSE( UNIT=11 )

    DO k = 1, daysinyear(l, j)
      WRITE(outfile(1:8),'(i8)') l*10000 + j*100 + k
      OPEN( UNIT=15, FILE='D:\气象?据\pre\'//outfile//'.txt' )
      DO i = 1, m
        IF( l==year(i) .AND. j==month(i) .AND. k==day(i) ) THEN
          Write (15, "(i5,2x,i4,2x,i5,2x,i4,2x,i2,2x,i2,2x,f5.2)") site(i), lat(i), lon(i), year(i), month(i), day(i), rain(i)
          WRITE(*,*) site(i), lat(i), lon(i), year(i), month(i), day(i), rain(i)
        END IF
      END DO
      CLOSE( UNIT=15 )
    END DO

    DEALLOCATE( site, lat, lon, year, month, day, rain )
  END DO
  END DO

End Program weather

!=======================================

Integer Function daysinyear(year, month)
  Integer, INTENT(IN) :: year, month

  Integer :: daysinmonth(12) = [ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ]

  If (((mod(year,4)==0) .And. (mod(year,100)/=0)) .Or. (mod(year,400)==0)) Then
    daysinmonth(2) = 29
  Else
    daysinmonth(2) = 28
  End If

  daysinyear = daysinmonth(month)
End Function daysinyear

67

帖子

16

主题

0

精华

专家

F 币
275 元
贡献
201 点
板凳
 楼主| 发表于 2017-8-24 15:06:19 | 只看该作者
chiangtp 发表于 2017-8-23 21:24
請參考看看:
[mw_shl_code=fortran,true]Program weather
  Implicit None

嗯嗯 谢谢 还想请教一下,这里如果我想做个缺省值判断,怎样在读取时跳过有缺省值的这一行呢,我这样写编译能通过,但打印不出结果来。Do i = 1, a
             If (rain(i)==32700 .or.rain(i)==32766) Then
                !   rain(i) = -999
                read(*,*)
                Read (11, *) site(i), lat(i), lon(i), h, year(i), month(i), day(i), pre1, pre2, rain(i)
                print*, year(i), month(i), day(i),rain(i)
        
          End If

130

帖子

10

主题

0

精华

大师

F 币
617 元
贡献
372 点

贡献勋章管理勋章帅哥勋章元老勋章星光勋章规矩勋章

地板
发表于 2017-8-24 17:08:47 | 只看该作者
wxy 发表于 2017-8-24 15:06
嗯嗯 谢谢 还想请教一下,这里如果我想做个缺省值判断,怎样在读取时跳过有缺省值的这一行呢,我这样写编 ...

請參考:
[Fortran] 纯文本查看 复制代码
  INTEGER :: mm

  DO l = 2010, 2015
  DO j = 1, 12
    WRITE(filename(32:37),'(i6)') l*100+j
    OPEN( UNIT=11, FILE='D:\气象数据\降水\'//filename, ACTION='READ' )

    m = 0
    DO
      READ(11,*,IOSTAT=ier) line
      IF( ier == -1 ) EXIT ! end-of-file
      m = m + 1
    END DO
    ALLOCATE (site(m), lat(m), lon(m), year(m), month(m), day(m), rain(m))

    REWIND( UNIT=11 )
    mm = 0
    DO i = 1, m
      mm = mm + 1
      READ(11,*) site(mm), lat(mm), lon(mm), h, year(mm), month(mm), day(mm), pre1, pre2, rain(mm)
      IF( rain(mm)==32700.0 .OR. rain(mm)==32766.0 ) mm = mm-1
    END DO
    CLOSE( UNIT=11 )

    DO k = 1, daysinyear(l, j)
      WRITE(outfile(1:8),'(i8)') l*10000 + j*100 + k
      OPEN( UNIT=15, FILE='D:\气象数据\pre\'//outfile//'.txt' )
      DO i = 1, mm
        IF( l==year(i) .AND. j==month(i) .AND. k==day(i) ) THEN
          WRITE(15, "(i5,2x,i4,2x,i5,2x,i4,2x,i2,2x,i2,2x,f5.2)") site(i), lat(i), lon(i), year(i), month(i), day(i), rain(i)
          WRITE(*,*) site(i), lat(i), lon(i), year(i), month(i), day(i), rain(i)
        END IF
      END DO
      CLOSE( UNIT=15 )
    END DO

    DEALLOCATE( site, lat, lon, year, month, day, rain )
  END DO
  END DO


1. 我不確定這是不是你的用意
2. "數(numeric)"的運算, 請維持"型態(type)"的一致性: rain(i)==32700.0

67

帖子

16

主题

0

精华

专家

F 币
275 元
贡献
201 点
5#
 楼主| 发表于 2017-8-25 12:11:00 | 只看该作者
明白了 ,谢谢
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

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

GMT+8, 2024-4-26 13:12

Powered by Tencent X3.4

© 2013-2024 Tencent

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