Fortran Wiki
fdate

This program shows the usage of the intrinsic DATE_AND_TIME procedure.

Note that to crack the command line header, it uses the module M_kracken.

An extended version of this program called “now” lets you print the date in a variety of other formats.

!-----------------------------------------------------------------------------------------------------------------------------------
! This program needs the following file to crack the command line
include "kracken.f90"
!-----------------------------------------------------------------------------------------------------------------------------------
PROGRAM fdate
!
! "@(#) fdate(1) writes timestamp using specified syntax"
!
   USE m_kracken                     ! command line parameter cracking module
   IMPLICIT NONE

   INTEGER , PARAMETER  :: clen=255  ! length of format
   CHARACTER(len=clen)  :: format    ! input format string

   INTEGER              :: ilen
   INTEGER              :: ier
   INTEGER              :: i10

   CHARACTER(LEN=8)     :: date      ! returned values from DATE_AND_TIME()
   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
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! CALL DATE_AND_TIME([DATE, TIME, ZONE, VALUES])
!
! gets the corresponding date and time information from the real-time system clock.
! DATE is INTENT(OUT) and has form ccyymmdd.
!      (Optional) The type shall be CHARACTER(8) or larger.
! TIME is INTENT(OUT) and has form hhmmss.sss.
!      (Optional) The type shall be CHARACTER(10) or larger.
! ZONE is INTENT(OUT) and has form (+-)hhmm, representing the difference with
!      respect to Coordinated Universal Time (UTC).
!      (Optional) The type shall be CHARACTER(5) or larger.
! Unavailable time and date parameters return blanks.
!
! VALUES is INTENT(OUT) and provides the following:
!       (Optional) The type shall be INTEGER(8).
!       VALUE(1):       The year
!       VALUE(2):       The month
!       VALUE(3):       The day of the month
!       VAlUE(4):       Time difference with UTC in minutes
!       VALUE(5):       The hour of the day
!       VALUE(6):       The minutes of the hour
!       VALUE(7):       The seconds of the minute
!       VALUE(8):       The milliseconds of the second
!
! Example:
!               ! using keyword arguments
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  crack command line
   CALL kracken('fdate',' -help .F. -version .F.')
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  display version number if --version is present
   IF(lget('fdate_version'))THEN
      WRITE(*,*)'fdate(1): version 1.0'
      STOP
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  display help text and exit if --help is present
   IF(lget('fdate_help'))THEN
      CALL usage()
   ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  get format
   format=' '
   CALL retrev('fdate_oo', format, ilen, ier) ! get any format before any keywords
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!  write string, when encounter a percent character do a substitution
   keyword=.FALSE.
   CALL DATE_AND_TIME(DATE=date,TIME=time,ZONE=zone,VALUES=values)
   IF(ilen.le.0)THEN
      WRITE(*,'(A,1X,A,1X,A)')date,time,zone
   ELSE
      DO i10=1,ilen
         char=format(i10:i10)
         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(*,'(I3.2)',ADVANCE='NO')int(values(4)/60)
                       WRITE(*,'(I2.2)',ADVANCE='NO')abs(mod(values(4),60))
            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(*,*)
      ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
END PROGRAM
!-----------------------------------------------------------------------------------------------------------------------------------
SUBROUTINE usage()
   !
   ! "@(#) usage(3f90) writes program help to stdout and exits
   !
      WRITE(*,*)'NAME'
      WRITE(*,*)'   fdate(1)'
      WRITE(*,*)''
      WRITE(*,*)'SYNOPSIS'
      WRITE(*,*)'   fdate FORMAT [--help ] [--version]'
      WRITE(*,*)''
      WRITE(*,*)'DESCRIPTION'
      WRITE(*,*)'   Read the FORMAT string and replace the following strings'
      WRITE(*,*)'      %D -- day of month, 01 to 31'
      WRITE(*,*)'      %M -- month of year, 01 to 12'
      WRITE(*,*)'      %Y -- year, yyyy'
      WRITE(*,*)'      %h -- hours, 01 to 12'
      WRITE(*,*)'      %m -- minutes, 00 to 59'
      WRITE(*,*)'      %s -- sec, 00 to 59'
      WRITE(*,*)'      %% -- %'
      WRITE(*,*)'      %u -- minutes from UTC'
      WRITE(*,*)'      %U -- -+hhmm from UTC'
      WRITE(*,*)'      %x -- milliseconds'
      WRITE(*,*)'   Default: %Y%M%D %h%m%s.%x %U'
      WRITE(*,*)''
      WRITE(*,*)'EXAMPLES'
      WRITE(*,*)''
      WRITE(*,*)'  %fdate The date is %Y/%M/%D %h:%m:%s'
      WRITE(*,*)'   The date is 2009/08/10 00:33:48'
      WRITE(*,*)''
      WRITE(*,*)'  %fdate YEAR=%Y MONTH=%M DAY=%D HOUR=%h MINUTES=%m SECONDS=%s MILLISECONDS=%x'
      WRITE(*,*)'   YEAR=2009 MONTH=08 DAY=10 HOUR=01 MINUTES=18 SECONDS=44 MILLISECONDS=946'
      WRITE(*,*)''
      WRITE(*,*)'   fdate ''"%D -- day of month, 01 to 31"'''
      WRITE(*,*)'   fdate ''"%M -- month of year, 01 to 12"'''
      WRITE(*,*)'   fdate ''"%Y -- year, yyyy"'''
      WRITE(*,*)'   fdate ''"%h -- hours, 01 to 12"'''
      WRITE(*,*)'   fdate ''"%m -- minutes, 00 to 59"'''
      WRITE(*,*)'   fdate ''"%s -- sec, 00 to 59"'''
      WRITE(*,*)'   fdate ''"%% -- %%"'''
      WRITE(*,*)'   fdate ''"%u -- minutes from UTC"'''
      WRITE(*,*)'   fdate ''"%U -- -+hhmm from UTC"'''
      WRITE(*,*)'   fdate ''"%x -- milliseconds"'''
      WRITE(*,*)'   fdate %Y%M%D %h%m%s.%x %U'
      WRITE(*,*)''
      WRITE(*,*)'AUTHOR'
      WRITE(*,*)'   John S. Urban'
      WRITE(*,*)''
      WRITE(*,*)'COPYRIGHT'
      WRITE(*,*)'   Copyright (C) 2009 John S. Urban'
      WRITE(*,*)'   This is free software: you are free to change and redistribute it.'
      WRITE(*,*)'   There is NO WARRANTY, to the extent permitted by law.'
      WRITE(*,*)''
      WRITE(*,*)'LIMITS'
      WRITE(*,*)''
      WRITE(*,*)'SEE ALSO'
      WRITE(*,*)'   date(1)'
      STOP
END SUBROUTINE usage
!-----------------------------------------------------------------------------------------------------------------------------------