alert Subroutine

public subroutine alert(type, message, g0, g1, g2, g3, g4, g5, g6, g7, g8, g9, ga, gb, gc, gd, ge, gf, gg, gh, gi, gj)

!>

NAME

alert(3f) - [M_attr] print messages using a standard format including
time and program name
(LICENSE:MIT)

SYNOPSIS

 subroutine alert(message,&
 g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,ga,gb,gc,gd,ge,gf,gg,gh,gi,gj)

    character(len=*),intent(in),optional :: type
    character(len=*),intent(in),optional :: message
    class(*),intent(in),optional :: g0,g1,g2,g3,g4,g5,g6,g7,g8,g9, &
                                  & ga,gb,gc,gd,ge,gf,gg,gh,gi,gj

DESCRIPTION

Display a message prefixed with a timestamp and the name
of the calling program when the TYPE is specified as any
of 'error','warn', or 'info'.

It also allows the keywords
<ARG0>,<TZ>,<YE>,<MO>,<DA>,<HR>,<MI>,<SE>,<MS> to be used in the
message (which is passed to ATTR(3f)).

Note that time stamp keywords will only be updated when using ALERT(3f)
and will only be displayed in color mode!

OPTIONS

TYPE     if present and one of 'warn','message','info', or 'debug'
         a predefined message is written to stderr of the form

          : <HR>:<MI>:<SE>.<MS> : (<ARG0>) : TYPE -> message

MESSAGE  the user-supplied message to display via a call to ATTR(3f)

g[0-9a-j]   optional values to print after the message. May
            be of type INTEGER, LOGICAL, REAL, DOUBLEPRECISION,
            COMPLEX, or CHARACTER.

if no parameters are supplied the macros are updated but no output
is generated.

EXAMPLE

Sample program

 program demo_alert
 use M_attr, only : alert, attr, attr_mode
 implicit none
 real X
  call attr_mode(manner='plain')
  call attr_mode(manner='color')
  call alert("error",&
            "Say you didn't!")
  call alert("warn", &
            "I wouldn't if I were you, Will Robinson.")
  call alert("info", &
            "I fixed that for you, but it was a bad idea.")
  call alert("debug", &
            "Who knows what is happening now?.")
  call alert("???    ",  "not today you don't")
  ! call to just update the macros
  call alert()
  ! conventional call to ATTR(3f) using the ALERT(3f)-defined macros
  write(*,*)attr(&
          '<bo>The year was <g><YE></g>, the month was <g><MO></g>')
  ! optional arguments
  X=211.3
  call alert('error',&
          'allowed range of X is 0 <lt> X <lt> 100, X=<r>',X)
  ! up to twenty values are allowed of intrinsic type
  call alert('info','values are<g>',10,234.567,&
          cmplx(11.0,22.0),123.456d0,'</g>today')
 end program demo_alert

Results:

 00:38:30: (prg) : error    -> Say you didn't!
 00:38:30: (prg) : warning  -> I wouldn't if I were you, ...
                               Will Robinson.
 00:38:30: (prg) : info     -> I fixed that for you,  ...
                               but it was a bad idea.
 00:38:30: (prg) : debug    -> Who knows what is happening now?. ...
 00:38:30: (prg) : ???      -> not today you don't
 00:38:30: (prg) : error    -> allowed range of X is 0  X  100, ...
                               X= 211.300003
 00:38:30: (prg) : info     -> values are 10 234.567001 ...
                               (11.0000000,22.0000000) ...
                               123.45600000000000 today

AUTHOR

John S. Urban, 2021

LICENSE

MIT

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in), optional :: type
character(len=*), intent(in), optional :: message
class(*), intent(in), optional :: g0
class(*), intent(in), optional :: g1
class(*), intent(in), optional :: g2
class(*), intent(in), optional :: g3
class(*), intent(in), optional :: g4
class(*), intent(in), optional :: g5
class(*), intent(in), optional :: g6
class(*), intent(in), optional :: g7
class(*), intent(in), optional :: g8
class(*), intent(in), optional :: g9
class(*), intent(in), optional :: ga
class(*), intent(in), optional :: gb
class(*), intent(in), optional :: gc
class(*), intent(in), optional :: gd
class(*), intent(in), optional :: ge
class(*), intent(in), optional :: gf
class(*), intent(in), optional :: gg
class(*), intent(in), optional :: gh
class(*), intent(in), optional :: gi
class(*), intent(in), optional :: gj

Source Code

subroutine alert(type,message,g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,ga,gb,gc,gd,ge,gf,gg,gh,gi,gj)
! TODO: could add a warning level to ignore info, or info|warning, or all
implicit none
character(len=*),intent(in),optional :: type
character(len=*),intent(in),optional :: message
class(*),intent(in),optional  :: g0,g1,g2,g3,g4,g5,g6,g7,g8,g9
class(*),intent(in),optional  :: ga,gb,gc,gd,ge,gf,gg,gh,gi,gj
character(len=8)      :: dt
character(len=10)     :: tm
character(len=5)      :: zone
integer,dimension(8)  :: values
character(len=4096)   :: arg0
character(len=:),allocatable :: new_message
character(len=:),allocatable :: other
logical :: printme
   call date_and_time(dt,tm,zone,values)
   call attr_update('YE',dt(1:4),dt(1:4))
   call attr_update('MO',dt(5:6),dt(5:6))
   call attr_update('DA',dt(7:8),dt(7:8))
   call attr_update('HR',tm(1:2),tm(1:2))
   call attr_update('MI',tm(3:4),tm(3:4))
   call attr_update('SE',tm(5:6),tm(5:6))
   call attr_update('MS',tm(8:10),tm(8:10))
   call attr_update('TZ',zone,zone)
   call get_command_argument(0,arg0)
   if(index(arg0,'/').ne.0) arg0=arg0(index(arg0,'/',back=.true.)+1:)
   if(index(arg0,'\').ne.0) arg0=arg0(index(arg0,'\',back=.true.)+1:)
   call attr_update('ARG0',arg0,arg0)
   printme=.true.
   if(present(type))then
      new_message= ' <b>'//tm(1:2)//':'//tm(3:4)//':'//tm(5:6)//'.'//tm(8:10)//'</b> : ('//trim(arg0)//') : '
      other=message//' '//str(g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,ga,gb,gc,gd,ge,gf,gg,gh,gi,gj)
      select case(type)

      case('warn','WARN','warning','WARNING')
       new_message= new_message//'<EBONY><bo><y>warning </y></EBONY> -<gt> '
       printme=alert_warn

      case('info','INFO','information','INFORMATION')
       new_message= new_message//'<EBONY><bo><g>info    </g></EBONY> -<gt> '
       printme=alert_info

      case('error','ERROR')
       new_message= new_message//'<EBONY><bo><r>error   </r></EBONY> -<gt> '
       printme=alert_error

      case('debug','DEBUG')
       new_message= new_message//'<EBONY><white><bo>debug   </white></EBONY> -<gt> '
       printme=alert_debug

      case default
       new_message= new_message//'<EBONY><bo><c>'//type//' </c></EBONY> -<gt> '
       printme=alert_other

      end select
    if(printme)then
       write(alert_unit,'(a)')attr(trim(new_message//other))
    endif

   elseif(present(message))then
    write(alert_unit,'(a)')attr(trim(other))
   endif
end subroutine alert