run_summary Subroutine

public subroutine run_summary()

Routine to print out a summary header author: P J Knight, CCFE, Culham Science Centre None This routine prints out a header summarising the program execution details, plus a list of the active iteration variables and constraint equations for the run. A User's Guide to the PROCESS Systems Code, P. J. Knight, AEA Fusion Report AEA FUS 251, 1993

Arguments

None

Contents

Source Code


Source Code

subroutine run_summary

  !! Routine to print out a summary header
  !! author: P J Knight, CCFE, Culham Science Centre
  !! None
  !! This routine prints out a header summarising the program
  !! execution details, plus a list of the active iteration
  !! variables and constraint equations for the run.
  !! A User's Guide to the PROCESS Systems Code, P. J. Knight,
  !! AEA Fusion Report AEA FUS 251, 1993
  !
  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  use constants, only: nout, mfile, iotty, mfile
  use maths_library, only: integer2string, integer3string
  use global_variables, only: maxcal, fileprefix, icase, runtitle
  use numerics, only: nvar, neqns, ioptimz, nineqns, epsvmc, minmax, icc, &
    lablcc, lablmm
  use process_output, only: ocentr, oblnkl, ocmmnt, ostars, ovarst, ovarin
  use physics_variables, only: te
  implicit none

  !  Local variables
  integer, parameter :: width = 110
  integer :: lap, ii, outfile
  character(len = 110) :: progid(0:10)
  character(len = 9)   :: vstring
  character(len = 8)   :: date
  character(len = 10)  :: time
  character(len = 12)  :: dstring
  character(len = 7)   :: tstring
  character(len = 10)  :: ustring
  character(len = 100) :: rstring
  character(len = 60)  :: fom_string
  character(len = 14)  :: minmax_string
  character(len = 10)  :: eps_string
  character :: minmax_sign

  ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  !  Obtain execution details for this run
  call inform(progid)

  !  Print code banner + run details to screen and output file
  do lap = 1,2
     if (lap == 1) then
        outfile = iotty
     else
        outfile = nout
     end if

     ! PROCESS code header
     call oblnkl(outfile)
     call ostars(outfile, width)
     call ocentr(outfile,'PROCESS', width)
     call ocentr(outfile,'Power Reactor Optimisation Code', width)
     call ostars(outfile, width)
     call oblnkl(outfile)

     !  Run execution details
     call ocmmnt(outfile, progid(1))  !  program name
     call ocmmnt(outfile, progid(2))  !  version
     if (untracked > 0) then  ! tag number
       call ocmmnt(outfile, '  Tag No. : '//tagno//' code contains untracked changes')
     else
       call ocmmnt(outfile, '  Tag No. : '//tagno)
     end if
     call ocmmnt(outfile, '   Branch : '//branch_name)
     call ocmmnt(outfile, '  Git log : '// &
     COMMSG)  !  Last git com message
     call ocmmnt(outfile, progid(3))  !  date/time
     call ocmmnt(outfile, progid(4))  !  user
     call ocmmnt(outfile, progid(5))  !  computer
     call ocmmnt(outfile, progid(6))  !  directory
     if (trim(fileprefix) == "") then
       call ocmmnt(outfile, '    Input : IN.DAT')  !  input file name
     else
       call ocmmnt(outfile, '    Input : '//trim(fileprefix))  !  input file name
     end if
     call ocmmnt(outfile, 'Run title : '//trim(runtitle))   ! run title
     call ocmmnt(outfile, ' Run type : Reactor concept design: '// trim(icase) // ', (c) CCFE')

     call oblnkl(outfile)
     call ostars(outfile, width)
     call oblnkl(outfile)
     call ocmmnt(outfile, '  Equality constraints : '//integer2string(neqns))  !  Number of equality constraints
     call ocmmnt(outfile, 'Inequality constraints : '//integer2string(nineqns))  !  Number of inequality constraints
     call ocmmnt(outfile, '     Total constraints : '//integer2string(neqns+nineqns))  !  Number of constraints
     call ocmmnt(outfile, '   Iteration variables : '//integer2string(nvar))  !  Number of iteration variables
     call ocmmnt(outfile, '        Max iterations : '//integer3string(maxcal))  !  Max number of iterations

     if (minmax > 0) then
      minmax_string = '  -- minimise '
      minmax_sign = "+"
     else
      minmax_string = '  -- maximise '
      minmax_sign = "-"
     end if
     fom_string = lablmm(abs(minmax))
     call ocmmnt(outfile, '      Figure of merit  : '//minmax_sign//integer2string(abs(minmax))//minmax_string//fom_string) ! Figure of merit

     write(eps_string, '(ES8.2)') epsvmc
     call ocmmnt(outfile, ' Convergence parameter : '//eps_string)  !  Convergence parameter
     call oblnkl(outfile)
     call ostars(outfile, width)
  end do

  call oblnkl(outfile)
  call ocmmnt(nout,'(Please include this header in any models, presentations and papers based on these results)')
  call oblnkl(nout)
  call ostars(nout, width)
  ! Issue #270
  call oblnkl(outfile)
  call ocmmnt(nout,'Quantities listed in standard row format are labelled as follows in columns 112-114:')
  call ocmmnt(nout,'ITV : Active iteration variable (in any output blocks)')
  call ocmmnt(nout,'OP  : Calculated output quantity')
  call ocmmnt(nout,'Unlabelled quantities in standard row format are generally inputs')
  call ocmmnt(nout,'Note that calculated quantities may be trivially rescaled from inputs, or equal to bounds which are input.')
  ! MDK Note that the label must be exactly three characters or none - I don't know how to fix this.

  !  Beware of possible future changes to the progid(...) layouts

  !  Relies on an internal read statement
  vstring = progid(2)(13:21)
  call ovarst(mfile,'PROCESS version number','(procver)','"'//vstring//'"')

  call date_and_time(date=date, time=time)

  !  Date output in the form "DD/MM/YYYY" (including quotes)
  dstring = '"'//date(7:8)//'/'//date(5:6)//'/'//date(1:4)//'"'
  call ovarst(mfile,'Date of run','(date)',dstring)

  !  Time output in the form "hh:mm" (including quotes)
  tstring = '"'//time(1:2)//':'//time(3:4)//'"'
  call ovarst(mfile,'Time of run','(time)',tstring)

  ustring = '"'//trim(progid(4)(13:20))//'"'
  call ovarst(mfile,'User','(username)',ustring)

  rstring = '"'//runtitle//'"'
  call ovarst(mfile,'PROCESS run title','(runtitle)',rstring)

  rstring = '"'//tagno//'"'
  call ovarst(mfile,'PROCESS tag number','(tagno)',rstring)

  rstring = '"'//branch_name//'"'
  call ovarst(mfile,'PROCESS git branch name','(branch_name)',rstring)

  rstring = '"'//COMMSG//'"'
  call ovarst(mfile,'PROCESS last commit message','(commsg)',rstring)

  call ovarst(mfile,'Input filename','(fileprefix)','"'//trim(fileprefix//'"'))

  if (ioptimz == -2) then
     call ovarin(mfile,'Optimisation switch','(ioptimz)',ioptimz)
     call ovarin(mfile,'Figure of merit switch','(minmax)',minmax)
  end if

#ifndef unit_test

  ! MDK Only print out the constraints here for HYBRD.
  ! For VMCON they are printed out later with residues.
  call oblnkl(nout)
  if (ioptimz == -1) then
      call ocmmnt(nout, 'The following constraint equations have been imposed,')
      call ocmmnt(nout, 'but limits will not be enforced by the code :')
      write(nout,30)
30    format(t10,'icc',t25,'label')
      call oblnkl(nout)
      write(nout,40) (ii,icc(ii),lablcc(icc(ii)), ii=1,neqns+nineqns)
40    format(t1,i3,t10,i3,t18,a33)
  end if

#endif

end subroutine run_summary