Routine to print a centred header within a line of asterisks
author: P J Knight, CCFE, Culham Science Centre
file : input integer : Fortran output unit identifier
string : input character string : Character string to be used
width : input integer : Total width of header
This routine writes out a centred header within a line of asterisks.
It cannot cope with a zero-length string; routine
ostars
should be used instead.
!
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | file | |||
character(len=*), | intent(in) | :: | string | |||
integer, | intent(in) | :: | width |
subroutine ocentr(file,string,width)
!! Routine to print a centred header within a line of asterisks
!! author: P J Knight, CCFE, Culham Science Centre
!! file : input integer : Fortran output unit identifier
!! string : input character string : Character string to be used
!! width : input integer : Total width of header
!! This routine writes out a centred header within a line of asterisks.
!! It cannot cope with a zero-length string; routine
!! <A HREF="ostars.html"><CODE>ostars</CODE></A> should be used instead.
!! !
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
use numerics, only: active_constraints, ncalls, ipnvars, ioptimz
use global_variables, only: run_tests, verbose, output_prefix
use constants, only: mfile
implicit none
! Arguments
integer, intent(in) :: file, width
character(len=*), intent(in) :: string
! Local variables
integer :: lh, nstars, nstars2
integer, parameter :: maxwidth = 110
character(len=maxwidth) :: stars
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
stars = repeat('*',maxwidth)
lh = len(string)
if (lh == 0) then
call ostars(file,width)
return
end if
if (width > maxwidth) then
write(*,*) 'Error in routine OCENTR :'
write(*,*) 'Maximum width = ',maxwidth
write(*,*) 'Requested width = ',width
write(*,*) 'PROCESS stopping.'
stop 1
end if
if (lh >= width) then
write(*,*) 'Error in routine OCENTR :'
write(*,*) string
write(*,*) 'This is too long to fit into ',width,' columns.'
write(*,*) 'PROCESS stopping.'
stop 1
end if
! Number of stars to be printed on the left
nstars = int( (width-lh)/2 ) - 1
! Number of stars to be printed on the right
nstars2 = width - (nstars+lh+2)
! Write the whole line
write(file,'(t2,a)') stars(1:nstars)//' '//string//' '//stars(1:nstars2)
write(mfile,'(t2,a)') '#'//' '//string//' '//'#'
end subroutine ocentr