Clicky
Showing changes from revision #8 to #9:
(追記) Added (追記ここまで) | (削除) Removed (削除ここまで) | (削除) Chan (削除ここまで)(追記) ged (追記ここまで)
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
20090930program 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.