一些便利的subroutine

kif117

之所以标注‘讨论’，因为并非全部原创，仅仅为个人使用和收集整理。力图使得这些sub可以根据功能直接粘贴使用。以后会尽量增加数量，也欢迎各位分享自己收集整理的。

1 表示时间:

[Fortran] 纯文本查看 复制代码

integer*4 time,time0,time1,dtime
      character(10)::d
      character(6)::t
      integer,dimension(8)::v

      d = ""
      call date_and_time(date=d,time=t)
      call date_and_time(values=V)
      PRINT *, "Date=",d,"Time=",t
      PRINT *, V

      subroutine timestamp ()
      implicit none
      character (len=8)ampm
      integer d
      character (len=8)date
      integer h
      integer m
      integer mm
      character ( len = 9 ), parameter, dimension(12) :: month = (/
    1'January  ', 'February ', 'March    ', 'April    ',
     1'May      ', 'June     ', 'July     ', 'August   ',
     1'September', 'October  ', 'November ', 'December ' /)
      integer n
      integer s
      character (len=10)time
      integer values(8)
      integer y
      character (len=5) zone

      call date_and_time (date,time,zone,values)

      y = values(1)
      m = values(2)
      d = values(3)
      h = values(5)
      n = values(6)
      s = values(7)
      mm = values(8)

      if (h<12) then
      ampm = 'AM'
      elseif (h==12) then
      if (n==0.and.s==0) then
      ampm='Noon'
      else
      ampm='PM'
      endif
      else
      h=h-12
      if (h<12) then
      ampm='PM'
      elseif (h==12) then
      if (n==0.and.s==0) then
      ampm='Midnight'
      else
      ampm='AM'
      endif
      endif
      endif
      write(*,'(1x,a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)')
    1trim(month(m) ), d, y, h, ':', n, ':', s, '.', mm,
     1trim(ampm)
      return
      end

如果是计算运行时间:

[Fortran] 纯文本查看 复制代码

      Real *8 time
      Integer *4 time0, time1, dtime
      Call system_clock(time0)
      ......
      Call system_clock(time1, dtime)
      time = 1D0*(time1-time0)/dtime
      Write (*, '(a7,f16.7)') 'Time = ', time

2 防止end-of-file

[Fortran] 纯文本查看 复制代码

integer GetFileN,ios
      character(10)::status
      ...
    open(10,...)
    do i=1, GetFileN(10)
    read(10,*,iostat=ios) number
    if(ios/=0) then
    exit
    endif  

      integer function GetFileN(iFileUnit)
      implicit none
      logical , parameter :: b = .True.
      integer , intent( IN ) :: iFileUnit
      character*(1) :: c
      GetFileN = 0
      rewind( iFileUnit )
    do while (b)
      read( iFileUnit , * ,end =999 ,Err = 999 )c
      GetFileN = GetFileN + 1
      end Do
999   rewind( iFileUnit )
      return
      end function GetFileN

fcode

感谢楼主的分享精神。

一点小建议：
一般来说，TimsStamp 具有特殊的意义，指用数字（一般是integer）表征的时间戳。例如Unix时间戳，Since1970s 等。所以我建议你换一个函数的名字。
另外，通用型的函数，最好不要写 write(*,*) ，因为你很可能想把结果写在文件里。那这个函数就没法重复使用了。所以，通用型的函数，可以返回一个字符串。当调用者需要写入文件、输出到屏幕，都可以自由选择。

GetFileN 这个函数应该是我写的，嘿嘿~~看来用的人很多嘛。想想还有点小激动呢。

kif117

fcode 发表于 2015-3-30 08:28
感谢楼主的分享精神。

一点小建议：

是您写的吗?! 我是几年以前在一个叫pfan论坛上，记得是一位论坛名字是‘臭石头雪球’的人给我的。非常感谢此人，当时我刚刚开始玩FORTRAN(其实是从办公室里随便翻到的程序cd)，不管我提出的问题有多么初级都耐心回答。但遗憾的是后来这个网站就不能使用了......

如我繁述，因为没有系统地花时间学习过fortran(但我有其他编程相关的经验)，只是自己写着玩，想必肯定有相当数量不妥当之处。您可以直接加以修改，以方便更多的人使用。便利好用的东西，当然使用的人越多越好，肯定的。这个帖子我会继续整理下去，也欢迎大家一起分享。

fcode

我就是臭石头雪球....pfan的老大估计是有家有孩子了，所以顾不上论坛了，也没人管理，所以我才做了这个网站。

kif117

fcode 发表于 2015-3-30 18:46
我就是臭石头雪球....pfan的老大估计是有家有孩子了，所以顾不上论坛了，也没人管理，所以我才做了 ...

OMG! 最近真的非常幸运，不断地遇到‘老朋友’! 上周参加国际学术会时发生了同样的事，今天又在网路上再次遇到同样的幸运!!!

您在那个论坛上帮助过其他人许多次，大概不会特别记得我了。但是我一直记得您的ID名!

看来幸运之神再次祝福了我，今天实在太愉快了!

fcode

确实记不清楚了，我对字母和数字的组合一向不敏感。所以我手边的便利贴很多。

我同样也感到很高兴，也祝福你！