Skip to content

Instantly share code, notes, and snippets.

@Low-power
Last active July 18, 2023 14:59
Show Gist options
  • Save Low-power/4fb9a7ba7c8d18d655e9e5efaeb306a0 to your computer and use it in GitHub Desktop.
Save Low-power/4fb9a7ba7c8d18d655e9e5efaeb306a0 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment