This subroutine reads out the status of the process if it is available in /proc/self/status, which is provided by the Linux operating system.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in), | optional | :: | unit | A preconnected unit, to write the content of /proc/self/status to. |
|
character(len=*), | intent(in), | optional | :: | info | optional filename prefix |
|
character(len=*), | intent(in), | optional | :: | text | optional header text to be dumped to file |
subroutine print_self_status(unit, info, text)
! ---------------------------------------------------------------------------
!> A preconnected unit, to write the content
!! of /proc/self/status to.
integer, optional, intent(in) :: unit
!> optional filename prefix
character(len=*), optional, intent(in) :: info
!> optional header text to be dumped to file
character(len=*), optional, intent(in) :: text
! ---------------------------------------------------------------------------
character(len=128) :: cInfo
character(len=128) :: line
integer :: stat
integer :: inUnit
integer :: outUnit
! ---------------------------------------------------------------------------
if( present( info )) then
cInfo = info
else
cInfo = '/proc/self/status'
end if
if( present( unit )) then
outUnit = unit
else
outUnit = output_unit
end if
inUnit = newUnit()
open( file = trim(cInfo), &
& action = 'read', &
& iostat = stat, &
& unit = inUnit )
if( present( text )) then
write(outUnit, '(a)') &
& '-------------------------------------------------------'
write(outUnit, '(2a)') ' ', trim(text)
end if
if (stat==0) then
read(inUnit, '(a)', iostat=stat) line
do while (stat==0)
if (present(unit)) then
write(unit,'(a)') trim(line)
else
write(*,'(a)') trim(line)
end if
read(inUnit, '(a)', iostat=stat) line
end do
close(inUnit)
else
write(outUnit,*) '/proc/self/'//trim(cInfo)//' not available'
end if
if( present( text )) then
write(outUnit, '(a)') &
& '-------------------------------------------------------'
end if
end subroutine print_self_status