logger_mod.f90

module logger_mod
    
    use env_mod
    use error_mod
    use optional_mod
    use character_mod

    implicit none

    private

    integer :: log_output = error_unit
        !* Log output file. Defaults to error stream
  
    interface fmt
        !* Simple formatting interface
        module procedure :: fmt_real4, fmt_real8, fmt_int
    end interface fmt

    character(len=*), parameter :: fmt_str_format = '("(A,",A,",A)")'

    public log, set_log_output, get_log_output, fmt

contains


    subroutine set_log_output(new_output, status)
        !* Change the file of log output. No argument: sets default.

        integer, intent(in), optional :: new_output
        integer(STINT), intent(out), optional :: status

        logical :: op
        character(len=7) :: writable
    
        call set_optional(NO_ERROR, opt=status)

        if (present(new_output)) then
            ! Check whether there is a writable file associated with
            ! `new_output` unit
            inquire (unit=new_output, opened=op, write=writable)
            ! Lower the case
            call to_lower(writable)
            
            if (op) then
                if (writable == 'yes') then
                    log_output = new_output
                    return
                end if
            end if
            ! Getting here only if invalid `new_output` was passed
            call set_optional(IO_FILE_ACCESS_ERROR, status)
            if (.not. present(status)) stop

        else
            ! Re-setting default value
            log_output = error_unit

        end if

    end subroutine set_log_output


    function get_log_output()
        !* Returns file ID of the current output.
        
        integer get_log_output
        
        get_log_output = log_output
    
    end function


    function fmt_real4(pref, num, suff, num_format) result(s)
        !* Formats single precision real with prefix & suffix.

        character(len=*), intent(in) :: pref, suff
        character(len=*), intent(in), optional :: num_format
        real(SP), intent(in) :: num
        
        character(len=len_trim(pref)+len_trim(suff)+40) :: s
        character(len=30) :: full_format

        if (present(num_format)) then
            
            write(unit=full_format, fmt=fmt_str_format) num_format
            write(unit=s, fmt=full_format) pref, num, suff
            
        else

            write(unit=s, fmt='(A,G0.6,A)') pref, num, suff

        end if

    end function fmt_real4


    function fmt_real8(pref, num, suff, num_format) result(s)
        !* Formats double precision real with prefix & suffix.

        character(len=*), intent(in) :: pref, suff
        character(len=*), intent(in), optional :: num_format
        real(DP), intent(in) :: num

        character(len=len_trim(pref)+len_trim(suff)+40) :: s
        character(len=30) :: full_format

        if (present(num_format)) then
            
            write(unit=full_format, fmt=fmt_str_format) num_format
            write(unit=s, fmt=full_format) pref, num, suff

        else

            write(s, '(A,G0.15,A)') pref, num, suff

        end if

    end function fmt_real8


    function fmt_int(pref, num, suff, num_format) result(s)
        !* Formats default integer with prefix & suffix.
        
        character(len=*), intent(in) :: pref, suff
        character(len=*), intent(in), optional :: num_format
        integer(STINT), intent(in) :: num
        character(len=len_trim(pref)+len_trim(suff)+40) :: s
        
        character(len=30) :: full_format

        if (present(num_format)) then
            
            write(unit=full_format, fmt=fmt_str_format) num_format
            write(unit=s, fmt=full_format) pref, num, suff
        
        else
        
            write(s, '(A,I12,A)') pref, num, suff
        
        end if
        
    end function fmt_int


    subroutine log(msg, prefix, timestamp)
        !* Outputs log message. The message is prefixed & optionally time stamped.
        
        character(len=*), intent(in) :: msg, prefix
        logical, intent(in), optional :: timestamp
        
        character(len=8) :: date
        character(len=10) :: time
        character(len=20) :: full_time
        
        if (default_or_optional(.false., timestamp)) then
            
            call date_and_time(date, time)
            
            write (full_time, '(" ", A,"/",A,"/",A," ",A,":",A,":",A)') &
                date(1:4), date(5:6), date(7:8), time(1:2), time(3:4), time(5:6)

        else

            full_time = ''
        
        end if
        
        write(log_output, '("[",A,A,"] ",A)') trim(prefix), trim(full_time), trim(msg)
        
    end subroutine log

end module logger_mod

loggerinc.f90

#define _INFO_(MSG)
#define _INFO_IF_(COND, MSG)
#define _DEBUG_(MSG)
#define _DEBUG_IF_(COND, MSG)
#define _ERROR_(MSG)
#define _ERROR_IF_(COND, MSG)
      
#ifdef LOGINFO
#define LOGDEBUG
#undef _INFO_
#undef _INFO_IF_
#define _INFO_(MSG) CALL LOG(MSG, 'INFO', .TRUE.)
#define _INFO_IF_(COND, MSG) IF (COND) CALL LOG(MSG, 'INFO', .TRUE.)
#endif

#ifdef LOGDEBUG
#define LOGERROR
#undef _DEBUG_
#undef _DEBUG_IF_
#define _DEBUG_(MSG) CALL LOG(MSG, 'DEBUG', .TRUE.)
#define _DEBUG_IF_(COND, MSG) IF (COND) CALL LOG(MSG, 'INFO', .TRUE.)
#endif

#ifdef LOGERROR
#undef _ERROR_
#undef _ERROR_IF_
#define _ERROR_(MSG) CALL LOG(MSG, 'ERROR', .TRUE.)
#define _ERROR_IF_(COND, MSG) IF (COND) CALL LOG(MSG, 'ERROR', .TRUE.)
#endif