encapsulate data, prefix only public functions

This commit is contained in:
Martin Diehl 2022-05-27 17:57:16 +02:00
parent f85e8a3ff4
commit b56ded62d9
1 changed files with 60 additions and 58 deletions

View File

@ -15,7 +15,6 @@ module IO
implicit none implicit none
private private
integer, parameter :: IO_panelwidth = 69
character(len=*), parameter, public :: & character(len=*), parameter, public :: &
IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters IO_WHITESPACE = achar(44)//achar(32)//achar(9)//achar(10)//achar(13), & !< whitespace characters
IO_QUOTES = "'"//'"' IO_QUOTES = "'"//'"'
@ -25,8 +24,6 @@ module IO
character, parameter :: & character, parameter :: &
CR = achar(13), & CR = achar(13), &
LF = IO_EOL LF = IO_EOL
character(len=*), parameter :: &
DIVIDER = repeat('─',IO_panelwidth)
public :: & public :: &
IO_init, & IO_init, &
@ -52,10 +49,11 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Do self test. !> @brief Do self test.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine IO_init subroutine IO_init()
print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT) print'(/,1x,a)', '<<<+- IO init -+>>>'; flush(IO_STDOUT)
call selfTest
call selfTest()
end subroutine IO_init end subroutine IO_init
@ -351,56 +349,6 @@ logical function IO_stringAsBool(string)
end function IO_stringAsBool end function IO_stringAsBool
!--------------------------------------------------------------------------------------------------
!> @brief Write statements to standard error.
!--------------------------------------------------------------------------------------------------
subroutine IO_panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
character(len=*), intent(in) :: paneltype,msg
character(len=*), optional, intent(in) :: ext_msg,label1,label2
integer, intent(in) :: ID
integer, optional, intent(in) :: ID1,ID2
character(len=pStringLen) :: formatString
if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1'
if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2'
if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1'
if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2'
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐'
write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,IO_panelwidth-24-len_trim(paneltype)),'x,a)'
write(IO_STDERR,formatString) ' │',trim(paneltype), '│'
write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,IO_panelwidth-24-3),'x,a)'
write(IO_STDERR,formatString) ' │',ID, '│'
write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤'
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,IO_panelwidth+3-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,IO_panelwidth+3-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(label1)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',&
max(1,IO_panelwidth+3-len_trim(label1)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│'
endif
if (present(label2)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',&
max(1,IO_panelwidth+3-len_trim(label2)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│'
endif
write(formatString,'(a,i2.2,a)') '(a,',max(1,IO_panelwidth),'x,a)'
write(IO_STDERR,formatString) ' │', '│'
write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘'
flush(IO_STDERR)
!$OMP END CRITICAL (write2out)
end subroutine IO_panel
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Write error statements and terminate the run with exit #9xxx. !> @brief Write error statements and terminate the run with exit #9xxx.
@ -586,7 +534,7 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
end select end select
call IO_panel('error',error_ID,msg, & call panel('error',error_ID,msg, &
ext_msg=ext_msg, & ext_msg=ext_msg, &
label1=label1,ID1=ID1, & label1=label1,ID1=ID1, &
label2=label2,ID2=ID2) label2=label2,ID2=ID2)
@ -623,7 +571,7 @@ subroutine IO_warning(warning_ID,ext_msg,label1,ID1,label2,ID2)
error stop 'invalid warning number' error stop 'invalid warning number'
end select end select
call IO_panel('warning',warning_ID,msg, & call panel('warning',warning_ID,msg, &
ext_msg=ext_msg, & ext_msg=ext_msg, &
label1=label1,ID1=ID1, & label1=label1,ID1=ID1, &
label2=label2,ID2=ID2) label2=label2,ID2=ID2)
@ -654,7 +602,61 @@ pure function CRLF2LF(string)
CRLF2LF = CRLF2LF(:c-n) CRLF2LF = CRLF2LF(:c-n)
end function end function CRLF2LF
!--------------------------------------------------------------------------------------------------
!> @brief Write statements to standard error.
!--------------------------------------------------------------------------------------------------
subroutine panel(paneltype,ID,msg,ext_msg,label1,ID1,label2,ID2)
character(len=*), intent(in) :: paneltype,msg
character(len=*), optional, intent(in) :: ext_msg,label1,label2
integer, intent(in) :: ID
integer, optional, intent(in) :: ID1,ID2
character(len=pStringLen) :: formatString
integer, parameter :: panelwidth = 69
character(len=*), parameter :: DIVIDER = repeat('─',panelwidth)
if (.not. present(label1) .and. present(ID1)) error stop 'missing label for value 1'
if (.not. present(label2) .and. present(ID2)) error stop 'missing label for value 2'
if ( present(label1) .and. .not. present(ID1)) error stop 'missing value for label 1'
if ( present(label2) .and. .not. present(ID2)) error stop 'missing value for label 2'
!$OMP CRITICAL (write2out)
write(IO_STDERR,'(/,a)') ' ┌'//DIVIDER//'┐'
write(formatString,'(a,i2,a)') '(a,24x,a,',max(1,panelwidth-24-len_trim(paneltype)),'x,a)'
write(IO_STDERR,formatString) ' │',trim(paneltype), '│'
write(formatString,'(a,i2,a)') '(a,24x,i3,',max(1,panelwidth-24-3),'x,a)'
write(IO_STDERR,formatString) ' │',ID, '│'
write(IO_STDERR,'(a)') ' ├'//DIVIDER//'┤'
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(msg)),',',&
max(1,panelwidth+3-len_trim(msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(msg), '│'
if (present(ext_msg)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a4,a',max(1,len_trim(ext_msg)),',',&
max(1,panelwidth+3-len_trim(ext_msg)-4),'x,a)'
write(IO_STDERR,formatString) '│ ',trim(ext_msg), '│'
endif
if (present(label1)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label1)),',i9,',&
max(1,panelwidth+3-len_trim(label1)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label1),ID1, '│'
endif
if (present(label2)) then
write(formatString,'(a,i3.3,a,i3.3,a)') '(1x,a7,a',max(1,len_trim(label2)),',i9,',&
max(1,panelwidth+3-len_trim(label2)-9-7),'x,a)'
write(IO_STDERR,formatString) '│ at ',trim(label2),ID2, '│'
endif
write(formatString,'(a,i2.2,a)') '(a,',max(1,panelwidth),'x,a)'
write(IO_STDERR,formatString) ' │', '│'
write(IO_STDERR,'(a)') ' └'//DIVIDER//'┘'
flush(IO_STDERR)
!$OMP END CRITICAL (write2out)
end subroutine panel
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------