mom_document Module Reference

Data Types
interface	doc_param
type	doc_type
type	link_msg

Functions/Subroutines
subroutine	doc_param_none (doc, varname, desc, units)
subroutine	doc_param_logical (doc, varname, desc, units, val, default, layoutParam)
subroutine	doc_param_logical_array (doc, varname, desc, units, vals, default, layoutParam)
subroutine	doc_param_int (doc, varname, desc, units, val, default, layoutParam)
subroutine	doc_param_int_array (doc, varname, desc, units, vals, default, layoutParam)
subroutine	doc_param_real (doc, varname, desc, units, val, default)
subroutine	doc_param_real_array (doc, varname, desc, units, vals, default)
subroutine	doc_param_char (doc, varname, desc, units, val, default, layoutParam)
subroutine, public	doc_openblock (doc, blockName, desc)
subroutine, public	doc_closeblock (doc, blockName)
subroutine	doc_param_time (doc, varname, desc, units, val, default, layoutParam)
subroutine	writemessageanddesc (doc, vmesg, desc, valueWasDefault, indent, layoutParam)
character(len=32) function	real_string (val)
character(len=1320) function	real_array_string (vals, sep)
logical function	testformattedfloatisreal (str, val)
character(len=24) function	int_string (val)
character(len=24) function	logical_string (val)
character(len=mlen) function	define_string (doc, varName, valString, units)
character(len=mlen) function	undef_string (doc, varName, units)
subroutine, public	doc_module (doc, modname, desc)
subroutine, public	doc_subroutine (doc, modname, subname, desc)
subroutine, public	doc_function (doc, modname, fnname, desc)
subroutine, public	doc_init (docFileBase, doc, minimal, complete)
subroutine	open_doc_file (doc)
integer function	find_unused_unit_number ()
subroutine, public	doc_end (doc)
logical function	mesghasbeendocumented (doc, varName, mesg)

Variables
integer, parameter	mlen = 1240
character(len=4), parameter	string_true = 'True'
character(len=5), parameter	string_false = 'False'

Function/Subroutine Documentation

define_string()

character(len=mlen) function mom_document::define_string ( type(doc_type), pointer  doc, character(len=*), intent(in)  varName, character(len=*), intent(in)  valString, character(len=*), intent(in)  units  )

private

Definition at line 580 of file MOM_document.F90.

References mlen.

Referenced by doc_param_char(), doc_param_int(), doc_param_int_array(), doc_param_logical(), doc_param_logical_array(), doc_param_real(), and doc_param_real_array().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, valstring, units
  character(len=mLen) :: define_string
! This function returns a string for formatted parameter assignment
  integer :: numspaces
  define_string = repeat(" ",mlen) ! Blank everything for safety
  if (doc%defineSyntax) then
    define_string = "#define "//trim(varname)//" "//valstring
  else
    define_string = trim(varname)//" = "//valstring
  endif
  numspaces = max(1, doc%commentColumn - len_trim(define_string) )
  define_string = trim(define_string)//repeat(" ",numspaces)//"!"
  if (len_trim(units) > 0) define_string = trim(define_string)//"   ["//trim(units)//"]"

Here is the caller graph for this function:

doc_closeblock()

subroutine, public mom_document::doc_closeblock	(	type(doc_type), pointer	doc,
		character(len=*), intent(in)	blockName
	)

Definition at line 353 of file MOM_document.F90.

References mom_error_handler::is_root_pe(), open_doc_file(), and writemessageanddesc().

Referenced by mom_file_parser::closeparameterblock().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: blockname
! This subroutine handles documentation for closing a parameter block.
  character(len=mLen) :: mesg
  character(len=doc%commentColumn) :: valstring
  integer :: i

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    mesg = '%'//trim(blockname)

    call writemessageanddesc(doc, mesg, '')
  endif
  i = index(trim(doc%blockPrefix), trim(blockname)//'%', .true.)
  if (i>1) then
    doc%blockPrefix = trim(doc%blockPrefix(1:i-1))
  else
    doc%blockPrefix = ''
  endif

Here is the call graph for this function:

Here is the caller graph for this function:

doc_end()

subroutine, public mom_document::doc_end

(

type(doc_type), pointer

doc

)

Definition at line 756 of file MOM_document.F90.

  type(doc_type), pointer :: doc
  type(link_msg), pointer :: this, next

  if (.not.associated(doc)) return

  if (doc%unitAll > 0) then
    close(doc%unitAll)
    doc%unitAll = -2
  endif

  if (doc%unitShort > 0) then
    close(doc%unitShort)
    doc%unitShort = -2
  endif

  if (doc%unitLayout > 0) then
    close(doc%unitLayout)
    doc%unitLayout = -2
  endif

  doc%filesAreOpen = .false.

  this => doc%chain_msg
  do while( associated(this) )
    next => this%next
    deallocate(this)
    this => next
  enddo

doc_function()

subroutine, public mom_document::doc_function	(	type(doc_type), pointer	doc,
		character(len=*), intent(in)	modname,
		character(len=*), intent(in)	fnname,
		character(len=*), intent(in)	desc
	)

Definition at line 642 of file MOM_document.F90.

References open_doc_file().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: modname, fnname, desc
! This subroutine handles the function documentation
  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

Here is the call graph for this function:

doc_init()

subroutine, public mom_document::doc_init	(	character(len=*), intent(in)	docFileBase,
		type(doc_type), pointer	doc,
		logical, intent(in), optional	minimal,
		logical, intent(in), optional	complete
	)

Definition at line 653 of file MOM_document.F90.

  character(len=*),  intent(in)  :: docfilebase
  type(doc_type),    pointer     :: doc
  logical, optional, intent(in)  :: minimal, complete
! Arguments: docFileBase - The name of the doc file.
!  (inout)   doc - The doc_type to populate.

  if (.not. associated(doc)) then
    allocate(doc)
  endif

  doc%docFileBase = docfilebase
  if (present(minimal)) doc%minimal = minimal
  if (present(minimal)) doc%complete = complete

doc_module()

subroutine, public mom_document::doc_module	(	type(doc_type), pointer	doc,
		character(len=*), intent(in)	modname,
		character(len=*), intent(in)	desc
	)

Definition at line 617 of file MOM_document.F90.

References open_doc_file(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: modname, desc
! This subroutine handles the module documentation
  character(len=mLen) :: mesg

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    call writemessageanddesc(doc, '', '') ! Blank line for delineation
    mesg = "! === module "//trim(modname)//" ==="
    call writemessageanddesc(doc, mesg, desc, indent=0)
  endif

Here is the call graph for this function:

doc_openblock()

subroutine, public mom_document::doc_openblock	(	type(doc_type), pointer	doc,
		character(len=*), intent(in)	blockName,
		character(len=*), intent(in), optional	desc
	)

Definition at line 330 of file MOM_document.F90.

References mom_error_handler::is_root_pe(), open_doc_file(), and writemessageanddesc().

Referenced by mom_file_parser::openparameterblock().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: blockname
  character(len=*), optional, intent(in) :: desc
! This subroutine handles documentation for opening a parameter block.
  character(len=mLen) :: mesg
  character(len=doc%commentColumn) :: valstring

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    mesg = trim(blockname)//'%'

    if (present(desc)) then
      call writemessageanddesc(doc, mesg, desc)
    else
      call writemessageanddesc(doc, mesg, '')
    endif
  endif
  doc%blockPrefix = trim(doc%blockPrefix)//trim(blockname)//'%'

Here is the call graph for this function:

Here is the caller graph for this function:

doc_param_char()

subroutine mom_document::doc_param_char ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, character(len=*), intent(in)  val, character(len=*), intent(in), optional  default, logical, intent(in), optional  layoutParam  )

private

Definition at line 302 of file MOM_document.F90.

References define_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  character(len=*), intent(in) :: val
  character(len=*), optional, intent(in) :: default
  logical,          optional, intent(in) :: layoutparam
! This subroutine handles parameter documentation for character strings.
  character(len=mLen) :: mesg
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    mesg = define_string(doc,varname,'"'//trim(val)//'"',units)

    equalsdefault = .false.
    if (present(default)) then
      if (trim(val) == trim(default)) equalsdefault = .true.
      mesg = trim(mesg)//' default = "'//trim(adjustl(default))//'"'
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault, layoutparam=layoutparam)
  endif

Here is the call graph for this function:

doc_param_int()

subroutine mom_document::doc_param_int ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, integer, intent(in)  val, integer, intent(in), optional  default, logical, intent(in), optional  layoutParam  )

private

Definition at line 177 of file MOM_document.F90.

References define_string(), int_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  integer,          intent(in) :: val
  integer,          optional, intent(in) :: default
  logical,          optional, intent(in) :: layoutparam
! This subroutine handles parameter documentation for integers.
  character(len=mLen) :: mesg
  character(len=doc%commentColumn)  :: valstring
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    valstring = int_string(val)
    mesg = define_string(doc,varname,valstring,units)

    equalsdefault = .false.
    if (present(default)) then
      if (val == default) equalsdefault = .true.
      mesg = trim(mesg)//" default = "//(trim(int_string(default)))
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault, layoutparam=layoutparam)
  endif

Here is the call graph for this function:

doc_param_int_array()

subroutine mom_document::doc_param_int_array ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, integer, dimension(:), intent(in)  vals, integer, intent(in), optional  default, logical, intent(in), optional  layoutParam  )

private

Definition at line 206 of file MOM_document.F90.

References define_string(), int_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  integer,          intent(in) :: vals(:)
  integer,          optional, intent(in) :: default
  logical,          optional, intent(in) :: layoutparam
! This subroutine handles parameter documentation for arrays of integers.
  integer :: i
  character(len=mLen) :: mesg
  character(len=mLen)  :: valstring
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    valstring = int_string(vals(1))
    do i=2,min(size(vals),128)
      valstring = trim(valstring)//", "//trim(int_string(vals(i)))
    enddo

    mesg = define_string(doc,varname,valstring,units)

    equalsdefault = .false.
    if (present(default)) then
      equalsdefault = .true.
      do i=1,size(vals) ; if (vals(i) /= default) equalsdefault = .false. ; enddo
      mesg = trim(mesg)//" default = "//(trim(int_string(default)))
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault, layoutparam=layoutparam)
  endif

Here is the call graph for this function:

doc_param_logical()

subroutine mom_document::doc_param_logical ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, logical, intent(in)  val, logical, intent(in), optional  default, logical, intent(in), optional  layoutParam  )

private

Definition at line 99 of file MOM_document.F90.

References define_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), string_false, string_true, undef_string(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  logical,          intent(in) :: val
  logical,          optional, intent(in) :: default
  logical,          optional, intent(in) :: layoutparam
! This subroutine handles parameter documentation for logicals.
  character(len=mLen) :: mesg
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    if (val) then
      mesg = define_string(doc,varname,string_true,units)
    else
      mesg = undef_string(doc,varname,units)
    endif

    equalsdefault = .false.
    if (present(default)) then
      if (val .eqv. default) equalsdefault = .true.
      if (default) then
        mesg = trim(mesg)//" default = "//string_true
      else
        mesg = trim(mesg)//" default = "//string_false
      endif
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault, layoutparam=layoutparam)
  endif

Here is the call graph for this function:

doc_param_logical_array()

subroutine mom_document::doc_param_logical_array ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, logical, dimension(:), intent(in)  vals, logical, intent(in), optional  default, logical, intent(in), optional  layoutParam  )

private

Definition at line 134 of file MOM_document.F90.

References define_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), string_false, string_true, and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  logical,          intent(in) :: vals(:)
  logical,          optional, intent(in) :: default
  logical,          optional, intent(in) :: layoutparam
! This subroutine handles parameter documentation for arrays of logicals.
  integer :: i
  character(len=mLen) :: mesg
  character(len=mLen) :: valstring
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    if (vals(1)) then ; valstring = string_true ; else ; valstring = string_false ; endif
    do i=2,min(size(vals),128)
      if (vals(i)) then
        valstring = trim(valstring)//", "//string_true
      else
        valstring = trim(valstring)//", "//string_false
      endif
    enddo

    mesg = define_string(doc,varname,valstring,units)

  equalsdefault = .false.
    if (present(default)) then
      equalsdefault = .true.
      do i=1,size(vals) ; if (vals(i) .neqv. default) equalsdefault = .false. ; enddo
      if (default) then
        mesg = trim(mesg)//" default = "//string_true
      else
        mesg = trim(mesg)//" default = "//string_false
      endif
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault, layoutparam=layoutparam)
  endif

Here is the call graph for this function:

doc_param_none()

subroutine mom_document::doc_param_none ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units  )

private

Definition at line 79 of file MOM_document.F90.

References mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
! This subroutine handles parameter documentation with no value.
  integer :: numspc
  character(len=mLen) :: mesg

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    numspc = max(1,doc%commentColumn-8-len_trim(varname))
    mesg = "#define "//trim(varname)//repeat(" ",numspc)//"!"
    if (len_trim(units) > 0) mesg = trim(mesg)//"   ["//trim(units)//"]"

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc)
  endif

Here is the call graph for this function:

doc_param_real()

subroutine mom_document::doc_param_real ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, real, intent(in)  val, real, intent(in), optional  default  )

private

Definition at line 242 of file MOM_document.F90.

References define_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), real_string(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  real,             intent(in) :: val
  real,             optional, intent(in) :: default
! This subroutine handles parameter documentation for reals.
  character(len=mLen) :: mesg
  character(len=doc%commentColumn)  :: valstring
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    valstring = real_string(val)
    mesg = define_string(doc,varname,valstring,units)

    equalsdefault = .false.
    if (present(default)) then
      if (val == default) equalsdefault = .true.
      mesg = trim(mesg)//" default = "//trim(real_string(default))
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault)
  endif

Here is the call graph for this function:

doc_param_real_array()

subroutine mom_document::doc_param_real_array ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, real, dimension(:), intent(in)  vals, real, intent(in), optional  default  )

private

Definition at line 270 of file MOM_document.F90.

References define_string(), mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), real_array_string(), real_string(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  real,             intent(in) :: vals(:)
  real,             optional, intent(in) :: default
! This subroutine handles parameter documentation for arrays of reals.
  integer :: i
  character(len=mLen) :: mesg
  character(len=mLen) :: valstring
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  if (doc%filesAreOpen) then
    valstring = trim(real_array_string(vals(:)))

    mesg = define_string(doc,varname,valstring,units)

    equalsdefault = .false.
    if (present(default)) then
      equalsdefault = .true.
      do i=1,size(vals) ; if (vals(i) /= default) equalsdefault = .false. ; enddo
      mesg = trim(mesg)//" default = "//trim(real_string(default))
    endif

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault)
  endif

Here is the call graph for this function:

doc_param_time()

subroutine mom_document::doc_param_time ( type(doc_type), pointer  doc, character(len=*), intent(in)  varname, character(len=*), intent(in)  desc, character(len=*), intent(in)  units, type(time_type), intent(in)  val, type(time_type), intent(in), optional  default, logical, intent(in), optional  layoutParam  )

private

Definition at line 377 of file MOM_document.F90.

References mom_error_handler::is_root_pe(), mesghasbeendocumented(), open_doc_file(), and writemessageanddesc().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, desc, units
  type(time_type),  intent(in) :: val
  type(time_type),  optional, intent(in) :: default
  logical,          optional, intent(in) :: layoutparam
! This subroutine handles parameter documentation for time-type variables.
!  ### This needs to be written properly!
  integer :: numspc
  character(len=mLen) :: mesg
  logical :: equalsdefault

  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

  equalsdefault = .false.
  if (doc%filesAreOpen) then
    numspc = max(1,doc%commentColumn-18-len_trim(varname))
    mesg = "#define "//trim(varname)//" Time-type"//repeat(" ",numspc)//"!"
    if (len_trim(units) > 0) mesg = trim(mesg)//"   ["//trim(units)//"]"

    if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
    call writemessageanddesc(doc, mesg, desc, equalsdefault, layoutparam=layoutparam)
  endif

Here is the call graph for this function:

doc_subroutine()

subroutine, public mom_document::doc_subroutine	(	type(doc_type), pointer	doc,
		character(len=*), intent(in)	modname,
		character(len=*), intent(in)	subname,
		character(len=*), intent(in)	desc
	)

Definition at line 633 of file MOM_document.F90.

References open_doc_file().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: modname, subname, desc
! This subroutine handles the subroutine documentation
  if (.not. (is_root_pe() .and. associated(doc))) return
  call open_doc_file(doc)

Here is the call graph for this function:

find_unused_unit_number()

integer function mom_document::find_unused_unit_number ( )

private

Definition at line 743 of file MOM_document.F90.

References mom_error_handler::mom_error().

Referenced by open_doc_file().

! Find an unused unit number.
! Returns >0 if found. FATAL if not.
  integer :: find_unused_unit_number
  logical :: opened
  do find_unused_unit_number=512,42,-1
    inquire( find_unused_unit_number, opened=opened)
    if (.not.opened) exit
  enddo
  if (opened) call mom_error(fatal, &
    "doc_init failed to find an unused unit number.")

Here is the call graph for this function:

Here is the caller graph for this function:

int_string()

character(len=24) function mom_document::int_string ( integer, intent(in)  val )

private

Definition at line 564 of file MOM_document.F90.

Referenced by doc_param_int(), doc_param_int_array(), and real_array_string().

  integer, intent(in)  :: val
  character(len=24)    :: int_string
! This function returns a string with an integer formatted like '(I)'
  write(int_string, '(i24)') val
  int_string = adjustl(int_string)

Here is the caller graph for this function:

logical_string()

character(len=24) function mom_document::logical_string ( logical, intent(in)  val )

private

Definition at line 572 of file MOM_document.F90.

  logical, intent(in)  :: val
  character(len=24)    :: logical_string
! This function returns a string with an logical formatted like '(L)'
  write(logical_string, '(l24)') val
  logical_string = adjustl(logical_string)

mesghasbeendocumented()

logical function mom_document::mesghasbeendocumented ( type(doc_type), pointer  doc, character(len=*), intent(in)  varName, character(len=*), intent(in)  mesg  )

private

Definition at line 789 of file MOM_document.F90.

References mom_error_handler::mom_error().

Referenced by doc_param_char(), doc_param_int(), doc_param_int_array(), doc_param_logical(), doc_param_logical_array(), doc_param_none(), doc_param_real(), doc_param_real_array(), and doc_param_time().

  type(doc_type),   pointer     :: doc
  character(len=*), intent(in)  :: varname, mesg
  logical                       :: mesghasbeendocumented
! Returns true if documentation has already been written
  type(link_msg), pointer :: newlink, this, last

  mesghasbeendocumented = .false.

!!if (mesg(1:1) == '!') return ! Ignore commented parameters

  ! Search through list for this parameter
  last => null()
  this => doc%chain_msg
  do while( associated(this) )
    if (trim(doc%blockPrefix)//trim(varname) == trim(this%name)) then
      mesghasbeendocumented = .true.
      if (trim(mesg) == trim(this%msg)) return
      ! If we fail the above test then cause an error
      if (mesg(1:1) == '!') return ! Do not cause error for commented parameters
      call mom_error(warning, "Previous msg:"//trim(this%msg))
      call mom_error(warning, "New message :"//trim(mesg))
      call mom_error(warning, "Encountered inconsistent documentation line for parameter "&
                     //trim(varname)//"!")
    endif
    last => this
    this => this%next
  enddo

  ! Allocate a new link
  allocate(newlink)
  newlink%name = trim(doc%blockPrefix)//trim(varname)
  newlink%msg = trim(mesg)
  newlink%next => null()
  if (.not. associated(doc%chain_msg)) then
    doc%chain_msg => newlink
  else
    if (.not. associated(last)) call mom_error(fatal, &
         "Unassociated LINK in mesgHasBeenDocumented: "//trim(mesg))
    last%next => newlink
  endif

Here is the call graph for this function:

Here is the caller graph for this function:

open_doc_file()

subroutine mom_document::open_doc_file ( type(doc_type), pointer  doc )

private

Definition at line 669 of file MOM_document.F90.

References find_unused_unit_number(), and mom_error_handler::mom_error().

Referenced by doc_closeblock(), doc_function(), doc_module(), doc_openblock(), doc_param_char(), doc_param_int(), doc_param_int_array(), doc_param_logical(), doc_param_logical_array(), doc_param_none(), doc_param_real(), doc_param_real_array(), doc_param_time(), and doc_subroutine().

  type(doc_type), pointer    :: doc

  logical :: opened, new_file
  integer :: ios
  character(len=240) :: filename

  if (.not. (is_root_pe() .and. associated(doc))) return

  if ((len_trim(doc%docFileBase) > 0) .and. doc%complete .and. (doc%unitAll<0)) then
    new_file = .true. ; if (doc%unitAll /= -1) new_file = .false.
    doc%unitAll = find_unused_unit_number()

    write(filename(1:240),'(a)') trim(doc%docFileBase)//'.all'
    if (new_file) then
      open(doc%unitAll, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
           action='WRITE', status='REPLACE', iostat=ios)
      write(doc%unitAll, '(a)') &
       '! This file was written by the model and records all non-layout parameters used at run-time.'
    else ! This file is being reopened, and should be appended.
      open(doc%unitAll, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
           action='WRITE', status='OLD', position='APPEND', iostat=ios)
    endif
    inquire(doc%unitAll, opened=opened)
    if ((.not.opened) .or. (ios /= 0)) then
      call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
    endif
    doc%filesAreOpen = .true.
  endif

  if ((len_trim(doc%docFileBase) > 0) .and. doc%minimal .and. (doc%unitShort<0)) then
    new_file = .true. ; if (doc%unitShort /= -1) new_file = .false.
    doc%unitShort = find_unused_unit_number()

    write(filename(1:240),'(a)') trim(doc%docFileBase)//'.short'
    if (new_file) then
      open(doc%unitShort, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
           action='WRITE', status='REPLACE', iostat=ios)
      write(doc%unitShort, '(a)') &
       '! This file was written by the model and records the non-default parameters used at run-time.'
    else ! This file is being reopened, and should be appended.
      open(doc%unitShort, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
           action='WRITE', status='OLD', position='APPEND', iostat=ios)
    endif
    inquire(doc%unitShort, opened=opened)
    if ((.not.opened) .or. (ios /= 0)) then
      call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
    endif
    doc%filesAreOpen = .true.
  endif

  if ((len_trim(doc%docFileBase) > 0) .and. doc%layout .and. (doc%unitLayout<0)) then
    new_file = .true. ; if (doc%unitLayout /= -1) new_file = .false.
    doc%unitLayout = find_unused_unit_number()

    write(filename(1:240),'(a)') trim(doc%docFileBase)//'.layout'
    if (new_file) then
      open(doc%unitLayout, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
           action='WRITE', status='REPLACE', iostat=ios)
      write(doc%unitLayout, '(a)') &
       '! This file was written by the model and records the layout parameters used at run-time.'
    else ! This file is being reopened, and should be appended.
      open(doc%unitLayout, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
           action='WRITE', status='OLD', position='APPEND', iostat=ios)
    endif
    inquire(doc%unitLayout, opened=opened)
    if ((.not.opened) .or. (ios /= 0)) then
      call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
    endif
    doc%filesAreOpen = .true.
  endif

Here is the call graph for this function:

Here is the caller graph for this function:

real_array_string()

character(len=1320) function mom_document::real_array_string ( real, dimension(:), intent(in)  vals, character(len=*), optional  sep  )

private

Definition at line 510 of file MOM_document.F90.

References int_string(), and real_string().

Referenced by doc_param_real_array().

  character(len=1320) :: real_array_string
  real, intent(in)  :: vals(:)
  character(len=*), optional :: sep
! Returns a character string of a comma-separated, compact formatted, reals
! e.g. "1., 2., 5*3., 5.E2"
  ! Local variables
  integer :: j, n, b, ns
  logical :: dowrite
  character(len=10) :: separator
  n=1 ; dowrite=.true. ; real_array_string='' ; b=1
  if (present(sep)) then
    separator=sep ; ns=len(sep)
  else
    separator=', ' ; ns=2
  endif
  do j=1,size(vals)
    dowrite=.true.
    if (j<size(vals)) then
      if (vals(j)==vals(j+1)) then
        n=n+1
        dowrite=.false.
      endif
    endif
    if (dowrite) then
      if (b>1) then ! Write separator if a number has already been written
        write(real_array_string(b:),'(A)') separator
        b=b+ns
      endif
      if (n>1) then
        write(real_array_string(b:),'(A,"*",A)') trim(int_string(n)),trim(real_string(vals(j)))
      else
        write(real_array_string(b:),'(A)') trim(real_string(vals(j)))
      endif
      n=1 ; b=len_trim(real_array_string)+1
    endif
  enddo

Here is the call graph for this function:

Here is the caller graph for this function:

real_string()

character(len=32) function mom_document::real_string ( real, intent(in)  val )

private

Definition at line 464 of file MOM_document.F90.

References testformattedfloatisreal().

Referenced by doc_param_real(), doc_param_real_array(), and real_array_string().

  real, intent(in)  :: val
  character(len=32) :: real_string
! This function returns a string with a real formatted like '(G)'
  integer :: len, ind

  if ((abs(val) < 1.0e4) .and. (abs(val) >= 1.0e-3)) then
    write(real_string, '(F30.11)') val
    if (.not.testformattedfloatisreal(real_string,val)) then
      write(real_string, '(F30.12)') val
      if (.not.testformattedfloatisreal(real_string,val)) then
        write(real_string, '(F30.13)') val
        if (.not.testformattedfloatisreal(real_string,val)) then
          write(real_string, '(F30.14)') val
          if (.not.testformattedfloatisreal(real_string,val)) then
            write(real_string, '(F30.15)') val
            if (.not.testformattedfloatisreal(real_string,val)) then
              write(real_string, '(F30.16)') val
            endif
          endif
        endif
      endif
    endif
    do
      len = len_trim(real_string)
      if ((len<2) .or. (real_string(len-1:len) == ".0") .or. &
          (real_string(len:len) /= "0")) exit
      real_string(len:len) = " "
    enddo
  elseif (val == 0.) then
    real_string = "0.0"
  else
    write(real_string(1:32), '(ES23.14)') val
    if (.not.testformattedfloatisreal(real_string,val)) then
     write(real_string(1:32), '(ES23.15)') val
    endif
    do
      ind = index(real_string,"0E")
      if (ind == 0) exit
      if (real_string(ind-1:ind-1) == ".") exit
      real_string = real_string(1:ind-1)//real_string(ind+1:)
    enddo
  endif
  real_string = adjustl(real_string)

Here is the call graph for this function:

Here is the caller graph for this function:

testformattedfloatisreal()

logical function mom_document::testformattedfloatisreal ( character(len=*), intent(in)  str, real, intent(in)  val  )

private

Definition at line 549 of file MOM_document.F90.

Referenced by real_string().

  character(len=*), intent(in) :: str
  real,             intent(in) :: val
  logical                      :: testformattedfloatisreal
  ! Local variables
  real :: scannedval

  read(str(1:),*) scannedval
  if (scannedval == val) then
    testformattedfloatisreal=.true.
  else
    testformattedfloatisreal=.false.
  endif

Here is the caller graph for this function:

undef_string()

character(len=mlen) function mom_document::undef_string ( type(doc_type), pointer  doc, character(len=*), intent(in)  varName, character(len=*), intent(in)  units  )

private

Definition at line 597 of file MOM_document.F90.

References string_false.

Referenced by doc_param_logical().

  type(doc_type),   pointer    :: doc
  character(len=*), intent(in) :: varname, units
  character(len=mLen) :: undef_string
! This function returns a string for formatted false logicals
  integer :: numspaces
  undef_string = repeat(" ",240) ! Blank everything for safety
  undef_string = "#undef "//trim(varname)
  if (doc%defineSyntax) then
    undef_string = "#undef "//trim(varname)
  else
    undef_string = trim(varname)//" = "//string_false
  endif
  numspaces = max(1, doc%commentColumn - len_trim(undef_string) )
  undef_string = trim(undef_string)//repeat(" ",numspaces)//"!"
  if (len_trim(units) > 0) undef_string = trim(undef_string)//"   ["//trim(units)//"]"

Here is the caller graph for this function:

writemessageanddesc()

subroutine mom_document::writemessageanddesc ( type(doc_type), intent(in)  doc, character(len=*), intent(in)  vmesg, character(len=*), intent(in)  desc, logical, intent(in), optional  valueWasDefault, integer, intent(in), optional  indent, logical, intent(in), optional  layoutParam  )

private

Definition at line 404 of file MOM_document.F90.

Referenced by doc_closeblock(), doc_module(), doc_openblock(), doc_param_char(), doc_param_int(), doc_param_int_array(), doc_param_logical(), doc_param_logical_array(), doc_param_none(), doc_param_real(), doc_param_real_array(), and doc_param_time().

  type(doc_type),             intent(in) :: doc
  character(len=*),           intent(in) :: vmesg, desc
  logical,          optional, intent(in) :: valuewasdefault
  integer,          optional, intent(in) :: indent
  logical,          optional, intent(in) :: layoutparam
  character(len=mLen) :: mesg
  integer :: start_ind = 1, end_ind, indnt, tab, len_tab, len_nl
  logical :: all, short, layout

  layout = .false.
  if (present(layoutparam)) layout = layoutparam
  all = doc%complete .and. (doc%unitAll > 0) .and. .not. layout
  short = doc%minimal .and. (doc%unitShort > 0) .and. .not. layout
  if (present(valuewasdefault)) short = short .and. (.not. valuewasdefault)

  if (all) write(doc%unitAll, '(a)') trim(vmesg)
  if (short) write(doc%unitShort, '(a)') trim(vmesg)
  if (layout) write(doc%unitLayout, '(a)') trim(vmesg)

  if (len_trim(desc) == 0) return

  len_tab = len_trim("_\t_") - 2
  len_nl = len_trim("_\n_") -2

  indnt = doc%commentColumn ; if (present(indent)) indnt = indent
  start_ind = 1
  do
    if (len_trim(desc(start_ind:)) < 1) exit

    end_ind = index(desc(start_ind:), "\n")

    if (end_ind > 0) then
      mesg = repeat(" ",indnt)//"! "//trim(desc(start_ind:start_ind+end_ind-2))
      start_ind = start_ind + end_ind - 1 + len_nl

      do ; tab = index(mesg, "\t")
        if (tab == 0) exit
        mesg(tab:) = "  "//trim(mesg(tab+len_tab:))
      enddo
      if (all) write(doc%unitAll, '(a)') trim(mesg)
      if (short) write(doc%unitShort, '(a)') trim(mesg)
      if (layout) write(doc%unitLayout, '(a)') trim(mesg)
    else
      mesg = repeat(" ",indnt)//"! "//trim(desc(start_ind:))
      do ; tab = index(mesg, "\t")
        if (tab == 0) exit
        mesg(tab:) = "  "//trim(mesg(tab+len_tab:))
      enddo
      if (all) write(doc%unitAll, '(a)') trim(mesg)
      if (short) write(doc%unitShort, '(a)') trim(mesg)
      if (layout) write(doc%unitLayout, '(a)') trim(mesg)
      exit
    endif

  enddo

Here is the caller graph for this function:

Variable Documentation

mlen

integer, parameter mom_document::mlen = 1240

private

Definition at line 46 of file MOM_document.F90.

Referenced by define_string().

integer, parameter :: mlen = 1240 ! Length of interface/message strings

string_false

character(len=5), parameter mom_document::string_false = 'False'

private

Definition at line 72 of file MOM_document.F90.

Referenced by doc_param_logical(), doc_param_logical_array(), and undef_string().

character(len=5), parameter :: STRING_FALSE = 'False'

string_true

character(len=4), parameter mom_document::string_true = 'True'

private

Definition at line 71 of file MOM_document.F90.

Referenced by doc_param_logical(), and doc_param_logical_array().

character(len=4), parameter :: STRING_TRUE = 'True'