ldate.f

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

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

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

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

      SUBROUTINE HANDLE_SIGNAL()
       IMPLICIT NONE
C      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 (OUTPUT_UNIT,"(A,A,A)",ADVANCE="NO"), 13, 27, "[1;30;47m"
         COLOR_STATUS = .FALSE.
        ELSE
         WRITE (OUTPUT_UNIT,"(A,A,A)",ADVANCE="NO"), 13, 27, "[0m"
         COLOR_STATUS = .TRUE.
        END IF
C       Needed for ifort(1)
        FLUSH OUTPUT_UNIT
        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