standard_header.f90 Source File

!> Contains functions for creating a standard header for files and output
module standard_header
  use uuid_mod, only : uuid_len
  implicit none

  !> A header for files and output.
  !>
  !> This is a type rather than a function so that we can use a
  !> consistent date/time and UUID across different files by reusing
  !> the same object.
  !>
  !> Call `standard_header_type::to_string` to get the header as text.
  type :: standard_header_type
    character(:), allocatable :: date_time
    character(len=uuid_len) :: run_uuid
  contains
    procedure :: to_string => standard_header_to_string
  end type standard_header_type

  interface standard_header_type
    module procedure make_standard_header
  end interface standard_header_type

contains

  !> Return the UUID for this run
  !>
  !> Generated when first called, guaranteed not to change during the
  !> simulation. Communicates when first called to broadcast the UUID
  !> to all processors
  function simulation_run_uuid()
    use mp, only : proc0, broadcast
    use uuid_mod, only : generate_uuid, uuid_len
    character(len=uuid_len) :: simulation_run_uuid
    character(len=uuid_len), save :: run_uuid
    logical, save :: first_run = .true.

    if (first_run) then
      if (proc0) then
        run_uuid = generate_uuid()
      end if
      call broadcast(run_uuid)
      first_run = .false.
    end if

    simulation_run_uuid = run_uuid
  end function simulation_run_uuid

  !> Return the current date and time in ISO8601 format:
  !>     YYYY-MM-DDThh:mm:ss.ssssZhh:mm
  function date_iso8601()
    character(:), allocatable :: date_iso8601
    character(8) :: date
    character(10) :: time
    character(5) :: zone
    call date_and_time(date, time, zone)

    date_iso8601 = date(1:4) // "-" // date(5:6) // "-" // date (7:8) &
         // "T" // time(1:2) // ":" // time(3:4) // ":" // time(5:10) &
         // "Z" // zone(1:3) // ":" // zone(4:5)
  end function date_iso8601

  !> Constructor for `standard_header_type`.
  !>
  !> Stores the date using `date_is08601` and the UUID using
  !> `simulation_run_uuid`. Note that this may involve collective
  !> communication, so all processors should be involved in
  !> construction.
  function make_standard_header() result(this)
    type(standard_header_type) :: this

    this%date_time = date_iso8601()
    this%run_uuid = simulation_run_uuid()
  end function make_standard_header

  !> Return a multiline string with a standard header of the form:
  !>
  !>     Created by GS2 at 2021-02-02T15:01:26.370Z+00:00
  !>     Run UUID: 36310A48-6A73-4941-9366-410C5731027A
  !>     GK_SYSTEM: ubuntu
  !>     Compiler: gfortran
  !>     <optional file description>
  !>
  !> If \p comment_character is passed, it is prepended to the start
  !> of each line. Note that it is used as-is, including any whitespace.
  function standard_header_to_string(this, comment_character, file_description) result(header)
    use runtime_tests, only: runtime_info
    use git_version_mod, only: get_git_version
    use build_config, only: gs2_build_tag
    use optionals, only: get_option_with_default
    character(:), allocatable :: header

    class(standard_header_type), intent(in) :: this
    !> Optional character(s) to start each line. Whitespace is not
    !> stripped or added. Default is empty string
    character(*), optional, intent(in) :: comment_character
    !> Optional file description. Treated as a single line, that is,
    !> new lines in this string will not begin with
    !> [[comment_character]]
    character(*), optional, intent(in) :: file_description

    ! Actual comment character to use, may be empty
    character(:), allocatable :: comment_char
    ! Note that description_line will contain the comment character if
    ! present
    character(:), allocatable :: description_line
    ! A literal new line `\n`, because Fortran
    character(*), parameter :: newline = new_line('a')

    comment_char = get_option_with_default(comment_character, "")
    description_line = get_option_with_default(file_description, "")
    if (len_trim(description_line) > 0) then
      ! If we add more lines to the header, we should add a newline here
      description_line = comment_char // description_line
    end if

    header = comment_char // "Created by GS2 at " // this%date_time // newline &
         // comment_char // "GS2 version: " // get_git_version() // newline &
         // comment_char // "Run UUID: " // this%run_uuid // newline &
         // comment_char // "GK_SYSTEM: " // trim(runtime_info%get_gk_system()) // newline &
         // comment_char // "Compiler: " // trim(runtime_info%get_compiler_name()) // newline &
         // comment_char // "Build tag: " // gs2_build_tag // newline &
         // description_line

  end function standard_header_to_string

end module standard_header