[子程序] 一些便利的subroutine

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

      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

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