Clicky

Fortran Wiki
fdate

This program shows the usage of the intrinsic DATE_AND_TIME procedure.

Examples:

    fdate
    2009-09-30 02:08:26-04:00

    fdate %Y%M%D
    20090930
program fdate
!
! "@(#) fdate(1) writes timestamp using specified syntax"
!
implicit none

! returned values from DATE_AND_TIME()
character(len=8)     :: date    
character(len=10)    :: time
character(len=5)     :: zone
integer,dimension(8) :: values    

logical              :: keyword   ! flag that previous character was a % character
character(len=1)     :: char      ! character being looked at in format string
character(len=:),allocatable :: format
integer                      :: i

   call get_cmd(format) ! get the format 
   if(format.eq.'')then
      format='%Y-%M-%D %h:%m:%s%U'
   else
      format=format//' '
   endif
   select case(format(:2))
   case('-h','-H')
      call usage()
   end select

   keyword=.false.
   call date_and_time(date=date,time=time,zone=zone,values=values)
   !  write string, when encounter a percent character do a substitution
   do i=1,len(format)
      char=format(i:i)
      if(char.eq.'%'.and..not.keyword)then
         keyword=.true.
         cycle
      endif
      if(keyword)then
         keyword=.false.
         select case(char)
         case('%'); write(*,'(a1)',advance='no')char
         case('Y'); write(*,'(i4.4)',advance='no')values(1)
         case('M'); write(*,'(i2.2)',advance='no')values(2)
         case('D'); write(*,'(i2.2)',advance='no')values(3)
         case('u'); write(*,'(i5.4)',advance='no')values(4)
         case('U'); write(*,'(3a)',  advance='no')zone(1:3),':',zone(4:5)
         case('h'); write(*,'(i2.2)',advance='no')values(5)
         case('m'); write(*,'(i2.2)',advance='no')values(6)
         case('s'); write(*,'(i2.2)',advance='no')values(7)
         case('x'); write(*,'(i3.3)',advance='no')values(8)
         case default
            write(*,'(a1)',advance='no')char
         end select
      else
         write(*,'(a1)',advance='no')char
      endif
   enddo
   write(*,*)

contains

subroutine get_cmd(command)
character(len=:),allocatable,intent(out) :: command
integer                                  :: i, j
character(len=:),allocatable             :: value
integer                                  :: length    
integer                                  :: status    
   command=""                                        
   status=0
   ERRORS: BLOCK
      do i=1,command_argument_count()
         call get_command_argument(i,length=length,status=status)
         if(status.ne.0)exit ERRORS
         value=repeat(' ',length)
         call get_command_argument(i,value=value,status=status) 
         if(status /= 0)exit ERRORS
	 command=command//' '//value
      enddo
      if(len(command).gt.1) command=command(2:)
      return
   endblock ERRORS
   write(*,'(*(g0,1x))')'*get_cmd* error obtaining argument ',i,'status=',status
   stop
end subroutine get_cmd

subroutine usage()
!
! "@(#) usage(3f90) writes program help to stdout and exits
!
integer :: i
character(len=:),allocatable :: help_text(:)
help_text=[ character(len=128) :: &
'NAME                                                                        ',&
'   fdate(1)                                                                 ',&
'                                                                            ',&
'SYNOPSIS                                                                    ',&
'   fdate FORMAT                                                             ',&
'                                                                            ',&
'DESCRIPTION                                                                 ',&
'   Read the FORMAT string and replace the following strings                 ',&
'      %D -- day of month, 01 to 31                                          ',&
'      %M -- month of year, 01 to 12                                         ',&
'      %Y -- year, yyyy                                                      ',&
'      %h -- hours, 01 to 12                                                 ',&
'      %m -- minutes, 00 to 59                                               ',&
'      %s -- sec, 00 to 59                                                   ',&
'      %% -- %                                                               ',&
'      %u -- minutes from UTC                                                ',&
'      %U -- -+hh:mm from UTC                                                ',&
'      %x -- milliseconds                                                    ',&
'   Default: %Y-%M-%D %h:%m:%s%U                                             ',&
'                                                                            ',&
'EXAMPLES                                                                    ',&
'                                                                            ',&
' fdate The date is %Y/%M/%D %h:%m:%s                                        ',&
' The date is 2009/08/10 00:33:48                                            ',&
'                                                                            ',&
' fdate YEAR=%Y MONTH=%M DAY=%D HOUR=%h MINUTES=%m SECONDS=%s MILLISECONDS=%x',&
' YEAR=2009 MONTH=08 DAY=10 HOUR=01 MINUTES=18 SECONDS=44 MILLISECONDS=946   ',&
'']
   write(*,'(a)') (trim(help_text(i)),i=1,size(help_text))
   stop
end subroutine usage

end program fdate

An extensive module called M_time lets you print and manipulate dates in a variety of other formats.

category: code