一些便利的subroutine - Fortran Coder

[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

[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