!******************************************************************************! ! ! ! This library is free software; you can redistribute it and/or ! ! modify it under the terms of the GNU Lesser General Public ! ! License as published by the Free Software Foundation; either ! ! version 2.1 of the License, or (at your option) any later version. ! ! ! ! This library is distributed in the hope that it will be useful, ! ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ! ! Lesser General Public License for more details. ! ! ! ! You should have received a copy of the GNU Lesser General Public ! ! License along with this library; if not, write to the Free Software ! ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ! ! ! !******************************************************************************! module timestamp_m implicit none contains !*****************************************************************************80 subroutine hms_current_hms ( h, m, s, mm ) !! HMS_CURRENT_HMS returns the current HMS time as integers. !! !! Example: !! !! If the current time is 9:45:54.872 AM, then !! !! H = 9 !! M = 45 !! S = 54 !! MM = 872 !! !! Licensing: !! !! This code is distributed under the GNU LGPL license. !! !! Modified: !! !! 26 February 2005 !! !! Author: !! !! John Burkardt !! !! Parameters: !! !! Output, integer ( kind = 4 ) H, M, S, MM, the current hour, minute, !! second, and thousandths of a second. implicit none integer ( kind = 4 ) h integer ( kind = 4 ) mm integer ( kind = 4 ) m integer ( kind = 4 ) s integer ( kind = 4 ) values(8) call date_and_time ( values = values ) h = values(5) m = values(6) s = values(7) mm = values(8) end subroutine !*****************************************************************************80 subroutine hms_current_print ( string ) !! HMS_CURRENT_PRINT prints the current HMS time, and a user specified string. !! !! Example: !! !! Wallclock: 9:45:54.872 AM Started determinant calculation. !! Wallclock: 9:47:32.738 AM Finished determinant calculation. !! !! Licensing: !! !! This code is distributed under the GNU LGPL license. !! !! Modified: !! !! 05 May 2003 !! !! Author: !! !! John Burkardt !! !! Parameters: !! !! Input, character ( len = * ) STRING, the string to be printed. implicit none character ( len = 15 ) string2 character ( len = * ) string call hms_current_string ( string2 ) write ( *, '(a,2x,a,2x,a)' ) 'Wallclock:', string2, trim ( string ) end subroutine !*****************************************************************************80 subroutine hms_current_string ( string ) !! HMS_CURRENT_STRING writes the current HMS data into a string. !! !! Example: !! !! STRING = ' 9:45:54.872 AM' !! !! Licensing: !! !! This code is distributed under the GNU LGPL license. !! !! Modified: !! !! 26 February 2005 !! !! Author: !! !! John Burkardt !! !! Parameters: !! !! Output, character ( len = * ) STRING, contains the HMS information. !! A character length of 15 should always be sufficient. implicit none character ( len = 2 ) ampm integer ( kind = 4 ) h integer ( kind = 4 ) mm integer ( kind = 4 ) n integer ( kind = 4 ) s character ( len = * ) string integer ( kind = 4 ) values(8) call date_and_time ( values = values ) h = values(5) n = values(6) s = values(7) mm = values(8) if ( h < 12 ) then ampm = 'AM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Nn' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Md' else ampm = 'AM' end if end if end if write ( string, '(i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & h, ':', n, ':', s, '.', mm, trim ( ampm ) end subroutine !*****************************************************************************80 subroutine hms_delta_print ( string ) !! HMS_DELTA_PRINT prints the change in HMS time, and a user specified string. !! !! Example: !! !! Delta Wallclock: 0:01:37.966 AM Determinant calculation. !! !! Licensing: !! !! This code is distributed under the GNU LGPL license. !! !! Modified: !! !! 06 May 2003 !! !! Author: !! !! John Burkardt !! !! Parameters: !! !! Input, character ( len = * ) STRING, the string to be printed. !! implicit none integer ( kind = 4 ), save :: h = -1 integer ( kind = 4 ) h_del integer ( kind = 4 ) h_old integer ( kind = 4 ), save :: m = 0 integer ( kind = 4 ) m_del integer ( kind = 4 ) m_old integer ( kind = 4 ), save :: mm = 0 integer ( kind = 4 ) mm_del integer ( kind = 4 ) mm_old integer ( kind = 4 ), save :: s = 0 integer ( kind = 4 ) s_del integer ( kind = 4 ) s_old character ( len = * ) string ! ! Back up the previous time. ! if ( h == -1 ) then call hms_current_hms ( h, m, s, mm ) h_old = h m_old = m s_old = s mm_old = mm else h_old = h m_old = m s_old = s mm_old = mm call hms_current_hms ( h, m, s, mm ) end if h_del = h - h_old m_del = m - m_old s_del = s - s_old mm_del = mm - mm_old if ( mm_del < 0 ) then s_del = s_del - 1 mm_del = mm_del + 1000 end if if ( s_del < 0 ) then m_del = m_del - 1 s_del = s_del + 60 end if if ( m_del < 0 ) then m_del = m_del + 60 h_del = h_del - 1 end if if ( h_del < 0 ) then h_del = h_del + 24 end if write ( *, '(a,i2,a1,i2.2,a1,i2.2,a1,i3.3,2x,a)' ) & 'Delta Wallclock: ', h_del, ':', m_del, ':', s_del, '.', mm_del, & trim ( string ) end subroutine !*****************************************************************************80 ! subroutine timestamp ( ) !! TIMESTAMP prints the current YMDHMS date as a time stamp. !! !! Example: !! !! 31 May 2001 9:45:54.872 AM !! !! Licensing: !! !! This code is distributed under the GNU LGPL license. !! !! Modified: !! !! 18 May 2013 !! !! Author: !! !! John Burkardt !! !! Parameters: !! !! None !! implicit none character ( len = 8 ) ampm integer ( kind = 4 ) d integer ( kind = 4 ) h integer ( kind = 4 ) m integer ( kind = 4 ) mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer ( kind = 4 ) n integer ( kind = 4 ) s integer ( kind = 4 ) values(8) integer ( kind = 4 ) y call date_and_time ( values = 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' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Midnight' else ampm = 'AM' end if end if end if write ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) end subroutine !*****************************************************************************80 ! subroutine timestring ( string ) !! TIMESTRING writes the current YMDHMS date into a string. !! !! Example: !! !! STRING = '31 May 2001 9:45:54.872 AM' !! !! Licensing: !! !! This code is distributed under the GNU LGPL license. !! !! Modified: !! !! 06 August 2005 !! !! Author: !! !! John Burkardt !! !! Parameters: !! !! Output, character ( len = * ) STRING, contains the date information. !! A character length of 40 should always be sufficient. !! implicit none character ( len = 8 ) ampm integer ( kind = 4 ) d integer ( kind = 4 ) h integer ( kind = 4 ) m integer ( kind = 4 ) mm character ( len = 6 ), parameter, dimension(12) :: month = (/ & 'Jan ', 'Feb ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'Aug ', & 'Sept ', 'Oct ', 'Nov ', 'Dec ' /) integer ( kind = 4 ) n integer ( kind = 4 ) s character ( len = * ) string integer ( kind = 4 ) values(8) integer ( kind = 4 ) y call date_and_time ( values = 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' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Noon' else ampm = 'PM' end if else h = h - 12 if ( h < 12 ) then ampm = 'PM' else if ( h == 12 ) then if ( n == 0 .and. s == 0 ) then ampm = 'Midnight' else ampm = 'AM' end if end if end if write ( string, '(i2.2,1x,a,1x,i4,1x,i0,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) end subroutine !******************************************************************************* end module timestamp_m