ldate.f95

! ldate with ANSI color code
! Copyright 2015-2023 Rivoreo

! Permission is hereby granted, free of charge, to any person obtaining
! a copy of this software and associated documentation files (the
! "Software"), to deal in the Software without restriction, including
! without limitation the rights to use, copy, modify, merge, publish,
! distribute, sublicense, and/or sell copies of the Software, and to
! permit persons to whom the Software is furnished to do so, subject to
! the following conditions:

! The above copyright notice and this permission notice shall be
! included in all copies or substantial portions of the Software.

! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
! NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
! FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
! CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
! WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

SUBROUTINE HANDLE_SIGNAL()
 IMPLICIT NONE
 !INTEGER, VALUE :: SIG
 WRITE (*, "(A,A)"), 27, "[0m"
 STOP
END SUBROUTINE
PROGRAM LDATE
 USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : OUTPUT_UNIT
 USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_INT 
 IMPLICIT NONE
 INTERFACE
  SUBROUTINE USLEEP(USEC) BIND(C, NAME="usleep")
   IMPORT C_INT
   INTEGER(C_INT), VALUE :: USEC
  END SUBROUTINE
 END INTERFACE
 EXTERNAL HANDLE_SIGNAL
 INTEGER, DIMENSION(8) :: DT
 INTEGER :: SIGNAL_STATUS = -1
 LOGICAL :: COLOR_STATUS = .FALSE.
 CALL SIGNAL(2, HANDLE_SIGNAL, SIGNAL_STATUS)
 DO
  CALL DATE_AND_TIME(VALUES=DT)
  IF(COLOR_STATUS) THEN
   WRITE (UNIT=OUTPUT_UNIT,FMT="(A,A,A)",ADVANCE="NO"), 13, 27, "[1;30;47m"
   COLOR_STATUS = .FALSE.
  ELSE
   WRITE (UNIT=OUTPUT_UNIT,FMT="(A,A,A)",ADVANCE="NO"), 13, 27, "[0m"
   COLOR_STATUS = .TRUE.
  END IF
  FLUSH OUTPUT_UNIT ! Needed for ifort(1)
  WRITE (UNIT=OUTPUT_UNIT,FMT="(I5,A,I2.2,A,I2.2,I3.2,A,I2.2,A,I2.2)",ADVANCE="NO"), &
   DT(1), "-", DT(2), "-", DT(3), DT(5), ":", DT(6), ":", DT(7)
  FLUSH OUTPUT_UNIT
  CALL USLEEP((1000 - DT(8)) * 1000)
 END DO
END PROGRAM