ocentr Subroutine

public 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 ostars should be used instead. !

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: file
character(len=*), intent(in) :: string
integer, intent(in) :: width

Contents

Source Code


Source Code

  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