MOM_document.F90

1! This file is part of MOM6, the Modular Ocean Model version 6.
2! See the LICENSE file for licensing information.
3! SPDX-License-Identifier: Apache-2.0
4
5!> The subroutines here provide hooks for document generation functions at
6!! various levels of granularity.
7module mom_document
8
9use mom_time_manager, only : time_type, operator(==), get_time, get_ticks_per_second
10use mom_error_handler, only : mom_error, fatal, warning, is_root_pe
11
12implicit none ; private
13
16
17!> Document parameter values
18interface doc_param
19 module procedure doc_param_none, &
25end interface
26
27integer, parameter :: mlen = 1240 !< Length of interface/message strings
28
29!> A structure that controls where the documentation occurs, its veborsity and formatting.
30type, public :: doc_type ; private
31 integer :: unitall = -1 !< The open unit number for docFileBase + .all.
32 integer :: unitshort = -1 !< The open unit number for docFileBase + .short.
33 integer :: unitlayout = -1 !< The open unit number for docFileBase + .layout.
34 integer :: unitdebugging = -1 !< The open unit number for docFileBase + .debugging.
35 logical :: filesareopen = .false. !< True if any files were successfully opened.
36 character(len=mLen) :: docfilebase = '' !< The basename of the files where run-time
37 !! parameters, settings and defaults are documented.
38 logical :: complete = .true. !< If true, document all parameters.
39 logical :: minimal = .true. !< If true, document non-default parameters.
40 logical :: layout = .true. !< If true, document layout parameters.
41 logical :: debugging = .true. !< If true, document debugging parameters.
42 logical :: definesyntax = .false. !< If true, use '\#def' syntax instead of a=b syntax
43 logical :: warnonconflicts = .false. !< Cause a WARNING error if defaults differ.
44 integer :: commentcolumn = 32 !< Number of spaces before the comment marker.
45 integer :: max_line_len = 112 !< The maximum length of message lines.
46 type(link_msg), pointer :: chain_msg => null() !< Database of messages
47 character(len=240) :: blockprefix = '' !< The full name of the current block.
48end type doc_type
49
50!> A linked list of the parameter documentation messages that have been issued so far.
51type :: link_msg ; private
52 type(link_msg), pointer :: next => null() !< Facilitates linked list
53 character(len=80) :: name !< Parameter name
54 character(len=620) :: msg !< Parameter value and default
55end type link_msg
56
57character(len=4), parameter :: string_true = 'True' !< A string for true logicals
58character(len=5), parameter :: string_false = 'False' !< A string for false logicals
59
60contains
61
62! ----------------------------------------------------------------------
63
64!> This subroutine handles parameter documentation with no value.
65subroutine doc_param_none(doc, varname, desc, units)
66 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
67 !! documentation occurs and its formatting
68 character(len=*), intent(in) :: varname !< The name of the parameter being documented
69 character(len=*), intent(in) :: desc !< A description of the parameter being documented
70 character(len=*), intent(in) :: units !< The units of the parameter being documented
71! This subroutine handles parameter documentation with no value.
72 integer :: numspc
73 character(len=mLen) :: mesg
74
75 if (.not. (is_root_pe() .and. associated(doc))) return
76 call open_doc_file(doc)
77
78 if (doc%filesAreOpen) then
79 numspc = max(1,doc%commentColumn-8-len_trim(varname))
80 mesg = "#define "//trim(varname)//repeat(" ",numspc)//"!"
81 if (len_trim(units) > 0) mesg = trim(mesg)//" ["//trim(units)//"]"
82
83 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
84 call writemessageanddesc(doc, mesg, desc)
85 endif
86end subroutine doc_param_none
87
88!> This subroutine handles parameter documentation for logicals.
89subroutine doc_param_logical(doc, varname, desc, units, val, default, &
90 layoutParam, debuggingParam, like_default)
91 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
92 !! documentation occurs and its formatting
93 character(len=*), intent(in) :: varname !< The name of the parameter being documented
94 character(len=*), intent(in) :: desc !< A description of the parameter being documented
95 character(len=*), intent(in) :: units !< The units of the parameter being documented
96 logical, intent(in) :: val !< The value of this parameter
97 logical, optional, intent(in) :: default !< The default value of this parameter
98 logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter.
99 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
100 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
101 !! it has the default value, even if there is no default.
102! This subroutine handles parameter documentation for logicals.
103 character(len=mLen) :: mesg
104 logical :: equalsDefault
105
106 if (.not. (is_root_pe() .and. associated(doc))) return
107 call open_doc_file(doc)
108
109 if (doc%filesAreOpen) then
110 if (val) then
111 mesg = define_string(doc, varname, string_true, units)
112 else
113 mesg = undef_string(doc, varname, units)
114 endif
115
116 equalsdefault = .false.
117 if (present(like_default)) equalsdefault = like_default
118 if (present(default)) then
119 if (val .eqv. default) equalsdefault = .true.
120 if (default) then
121 mesg = trim(mesg)//" default = "//string_true
122 else
123 mesg = trim(mesg)//" default = "//string_false
124 endif
125 endif
126
127 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
128 call writemessageanddesc(doc, mesg, desc, equalsdefault, &
129 layoutparam=layoutparam, debuggingparam=debuggingparam)
130 endif
131end subroutine doc_param_logical
132
133!> This subroutine handles parameter documentation for arrays of logicals.
134subroutine doc_param_logical_array(doc, varname, desc, units, vals, default, &
135 layoutParam, debuggingParam, like_default)
136 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
137 !! documentation occurs and its formatting
138 character(len=*), intent(in) :: varname !< The name of the parameter being documented
139 character(len=*), intent(in) :: desc !< A description of the parameter being documented
140 character(len=*), intent(in) :: units !< The units of the parameter being documented
141 logical, intent(in) :: vals(:) !< The array of values to record
142 logical, optional, intent(in) :: default !< The default value of this parameter
143 logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter.
144 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
145 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
146 !! it has the default value, even if there is no default.
147! This subroutine handles parameter documentation for arrays of logicals.
148 integer :: i
149 character(len=mLen) :: mesg
150 character(len=mLen) :: valstring
151 logical :: equalsDefault
152
153 if (.not. (is_root_pe() .and. associated(doc))) return
154 call open_doc_file(doc)
155
156 if (doc%filesAreOpen) then
157 if (vals(1)) then ; valstring = string_true ; else ; valstring = string_false ; endif
158 do i=2,min(size(vals),128)
159 if (vals(i)) then
160 valstring = trim(valstring)//", "//string_true
161 else
162 valstring = trim(valstring)//", "//string_false
163 endif
164 enddo
165
166 mesg = define_string(doc, varname, valstring, units)
167
168 equalsdefault = .false.
169 if (present(default)) then
170 equalsdefault = .true.
171 do i=1,size(vals) ; if (vals(i) .neqv. default) equalsdefault = .false. ; enddo
172 if (default) then
173 mesg = trim(mesg)//" default = "//string_true
174 else
175 mesg = trim(mesg)//" default = "//string_false
176 endif
177 endif
178 if (present(like_default)) then ; if (like_default) equalsdefault = .true. ; endif
179
180 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
181 call writemessageanddesc(doc, mesg, desc, equalsdefault, &
182 layoutparam=layoutparam, debuggingparam=debuggingparam)
183 endif
184end subroutine doc_param_logical_array
185
186!> This subroutine handles parameter documentation for integers.
187subroutine doc_param_int(doc, varname, desc, units, val, default, &
188 layoutParam, debuggingParam, like_default)
189 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
190 !! documentation occurs and its formatting
191 character(len=*), intent(in) :: varname !< The name of the parameter being documented
192 character(len=*), intent(in) :: desc !< A description of the parameter being documented
193 character(len=*), intent(in) :: units !< The units of the parameter being documented
194 integer, intent(in) :: val !< The value of this parameter
195 integer, optional, intent(in) :: default !< The default value of this parameter
196 logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter.
197 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
198 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
199 !! it has the default value, even if there is no default.
200! This subroutine handles parameter documentation for integers.
201 character(len=mLen) :: mesg
202 character(len=doc%commentColumn) :: valstring
203 logical :: equalsDefault
204
205 if (.not. (is_root_pe() .and. associated(doc))) return
206 call open_doc_file(doc)
207
208 if (doc%filesAreOpen) then
209 valstring = int_string(val)
210 mesg = define_string(doc, varname, valstring, units)
211
212 equalsdefault = .false.
213 if (present(like_default)) equalsdefault = like_default
214 if (present(default)) then
215 if (val == default) equalsdefault = .true.
216 mesg = trim(mesg)//" default = "//(trim(int_string(default)))
217 endif
218
219 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
220 call writemessageanddesc(doc, mesg, desc, equalsdefault, &
221 layoutparam=layoutparam, debuggingparam=debuggingparam)
222 endif
223end subroutine doc_param_int
224
225!> This subroutine handles parameter documentation for arrays of integers.
226subroutine doc_param_int_array(doc, varname, desc, units, vals, default, defaults, &
227 layoutParam, debuggingParam, like_default)
228 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
229 !! documentation occurs and its formatting
230 character(len=*), intent(in) :: varname !< The name of the parameter being documented
231 character(len=*), intent(in) :: desc !< A description of the parameter being documented
232 character(len=*), intent(in) :: units !< The units of the parameter being documented
233 integer, intent(in) :: vals(:) !< The array of values to record
234 integer, optional, intent(in) :: default !< The uniform default value of this parameter
235 integer, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter
236 logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter.
237 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
238 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
239 !! it has the default value, even if there is no default.
240! This subroutine handles parameter documentation for arrays of integers.
241 integer :: i
242 character(len=mLen) :: mesg
243 character(len=mLen) :: valstring
244 logical :: equalsDefault
245
246 if (.not. (is_root_pe() .and. associated(doc))) return
247 call open_doc_file(doc)
248
249 if (doc%filesAreOpen) then
250 valstring = int_string(vals(1))
251 do i=2,min(size(vals),128)
252 valstring = trim(valstring)//", "//trim(int_string(vals(i)))
253 enddo
254
255 mesg = define_string(doc, varname, valstring, units)
256
257 equalsdefault = .false.
258 if (present(default)) then
259 equalsdefault = .true.
260 do i=1,size(vals) ; if (vals(i) /= default) equalsdefault = .false. ; enddo
261 mesg = trim(mesg)//" default = "//(trim(int_string(default)))
262 endif
263 if (present(defaults)) then
264 equalsdefault = .true.
265 do i=1,size(vals) ; if (vals(i) /= defaults(i)) equalsdefault = .false. ; enddo
266 mesg = trim(mesg)//" default = "//trim(int_array_string(defaults))
267 endif
268 if (present(like_default)) then ; if (like_default) equalsdefault = .true. ; endif
269
270 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
271 call writemessageanddesc(doc, mesg, desc, equalsdefault, &
272 layoutparam=layoutparam, debuggingparam=debuggingparam)
273 endif
274
275end subroutine doc_param_int_array
276
277!> This subroutine handles parameter documentation for reals.
278subroutine doc_param_real(doc, varname, desc, units, val, default, debuggingParam, like_default)
279 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
280 !! documentation occurs and its formatting
281 character(len=*), intent(in) :: varname !< The name of the parameter being documented
282 character(len=*), intent(in) :: desc !< A description of the parameter being documented
283 character(len=*), intent(in) :: units !< The units of the parameter being documented
284 real, intent(in) :: val !< The value of this parameter
285 real, optional, intent(in) :: default !< The default value of this parameter
286 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
287 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
288 !! it has the default value, even if there is no default.
289! This subroutine handles parameter documentation for reals.
290 character(len=mLen) :: mesg
291 character(len=doc%commentColumn) :: valstring
292 logical :: equalsDefault
293
294 if (.not. (is_root_pe() .and. associated(doc))) return
295 call open_doc_file(doc)
296
297 if (doc%filesAreOpen) then
298 valstring = real_string(val)
299 mesg = define_string(doc, varname, valstring, units)
300
301 equalsdefault = .false.
302 if (present(like_default)) equalsdefault = like_default
303 if (present(default)) then
304 if (val == default) equalsdefault = .true.
305 mesg = trim(mesg)//" default = "//trim(real_string(default))
306 endif
307
308 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
309 call writemessageanddesc(doc, mesg, desc, equalsdefault, debuggingparam=debuggingparam)
310 endif
311end subroutine doc_param_real
312
313!> This subroutine handles parameter documentation for arrays of reals.
314subroutine doc_param_real_array(doc, varname, desc, units, vals, default, defaults, &
315 debuggingParam, like_default)
316 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
317 !! documentation occurs and its formatting
318 character(len=*), intent(in) :: varname !< The name of the parameter being documented
319 character(len=*), intent(in) :: desc !< A description of the parameter being documented
320 character(len=*), intent(in) :: units !< The units of the parameter being documented
321 real, intent(in) :: vals(:) !< The array of values to record
322 real, optional, intent(in) :: default !< A uniform default value of this parameter
323 real, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter
324 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
325 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
326 !! it has the default value, even if there is no default.
327! This subroutine handles parameter documentation for arrays of reals.
328 integer :: i
329 character(len=mLen) :: mesg
330 character(len=mLen) :: valstring
331 logical :: equalsDefault
332
333 if (.not. (is_root_pe() .and. associated(doc))) return
334 call open_doc_file(doc)
335
336 if (doc%filesAreOpen) then
337 valstring = trim(real_array_string(vals(:)))
338
339 mesg = define_string(doc, varname, valstring, units)
340
341 equalsdefault = .false.
342 if (present(default)) then
343 equalsdefault = .true.
344 do i=1,size(vals) ; if (vals(i) /= default) equalsdefault = .false. ; enddo
345 mesg = trim(mesg)//" default = "//trim(real_string(default))
346 endif
347 if (present(defaults)) then
348 equalsdefault = .true.
349 do i=1,size(vals) ; if (vals(i) /= defaults(i)) equalsdefault = .false. ; enddo
350 mesg = trim(mesg)//" default = "//trim(real_array_string(defaults))
351 endif
352 if (present(like_default)) then ; if (like_default) equalsdefault = .true. ; endif
353
354 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
355 call writemessageanddesc(doc, mesg, desc, equalsdefault, debuggingparam=debuggingparam)
356 endif
357
358end subroutine doc_param_real_array
359
360!> This subroutine handles parameter documentation for character strings.
361subroutine doc_param_char(doc, varname, desc, units, val, default, &
362 layoutParam, debuggingParam, like_default)
363 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
364 !! documentation occurs and its formatting
365 character(len=*), intent(in) :: varname !< The name of the parameter being documented
366 character(len=*), intent(in) :: desc !< A description of the parameter being documented
367 character(len=*), intent(in) :: units !< The units of the parameter being documented
368 character(len=*), intent(in) :: val !< The value of the parameter
369 character(len=*), &
370 optional, intent(in) :: default !< The default value of this parameter
371 logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter.
372 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
373 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
374 !! it has the default value, even if there is no default.
375! This subroutine handles parameter documentation for character strings.
376 character(len=mLen) :: mesg
377 logical :: equalsDefault
378
379 if (.not. (is_root_pe() .and. associated(doc))) return
380 call open_doc_file(doc)
381
382 if (doc%filesAreOpen) then
383 mesg = define_string(doc, varname, '"'//trim(val)//'"', units)
384
385 equalsdefault = .false.
386 if (present(like_default)) equalsdefault = like_default
387 if (present(default)) then
388 if (trim(val) == trim(default)) equalsdefault = .true.
389 mesg = trim(mesg)//' default = "'//trim(adjustl(default))//'"'
390 endif
391
392 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
393 call writemessageanddesc(doc, mesg, desc, equalsdefault, &
394 layoutparam=layoutparam, debuggingparam=debuggingparam)
395 endif
396
397end subroutine doc_param_char
398
399!> This subroutine handles documentation for opening a parameter block.
400subroutine doc_openblock(doc, blockName, desc)
401 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
402 !! documentation occurs and its formatting
403 character(len=*), intent(in) :: blockname !< The name of the parameter block being opened
404 character(len=*), optional, intent(in) :: desc !< A description of the parameter block being opened
405! This subroutine handles documentation for opening a parameter block.
406 character(len=mLen) :: mesg
407
408 if (.not. (is_root_pe() .and. associated(doc))) return
409 call open_doc_file(doc)
410
411 if (doc%filesAreOpen) then
412 mesg = trim(blockname)//'%'
413
414 if (present(desc)) then
415 call writemessageanddesc(doc, mesg, desc)
416 else
417 call writemessageanddesc(doc, mesg, '')
418 endif
419 endif
420 doc%blockPrefix = trim(doc%blockPrefix)//trim(blockname)//'%'
421end subroutine doc_openblock
422
423!> This subroutine handles documentation for closing a parameter block.
424subroutine doc_closeblock(doc, blockName)
425 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
426 !! documentation occurs and its formatting
427 character(len=*), intent(in) :: blockname !< The name of the parameter block being closed
428! This subroutine handles documentation for closing a parameter block.
429 character(len=mLen) :: mesg
430 integer :: i
431
432 if (.not. (is_root_pe() .and. associated(doc))) return
433 call open_doc_file(doc)
434
435 if (doc%filesAreOpen) then
436 mesg = '%'//trim(blockname)
437
438 call writemessageanddesc(doc, mesg, '')
439 endif
440 i = index(trim(doc%blockPrefix), trim(blockname)//'%', .true.)
441 if (i>1) then
442 doc%blockPrefix = trim(doc%blockPrefix(1:i-1))
443 else
444 doc%blockPrefix = ''
445 endif
446end subroutine doc_closeblock
447
448!> This subroutine handles parameter documentation for time-type variables.
449subroutine doc_param_time(doc, varname, desc, val, default, units, debuggingParam, like_default)
450 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
451 !! documentation occurs and its formatting
452 character(len=*), intent(in) :: varname !< The name of the parameter being documented
453 character(len=*), intent(in) :: desc !< A description of the parameter being documented
454 type(time_type), intent(in) :: val !< The value of the parameter
455 type(time_type), optional, intent(in) :: default !< The default value of this parameter
456 character(len=*), optional, intent(in) :: units !< The units of the parameter being documented
457 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
458 logical, optional, intent(in) :: like_default !< If present and true, log this parameter as though
459 !! it has the default value, even if there is no default.
460
461 ! Local varables
462 character(len=mLen) :: mesg ! The output message
463 character(len=doc%commentColumn) :: valstring ! A string with the formatted value.
464 logical :: equalsDefault ! True if val = default.
465
466 if (.not. (is_root_pe() .and. associated(doc))) return
467 call open_doc_file(doc)
468
469 if (doc%filesAreOpen) then
470 valstring = time_string(val)
471 if (present(units)) then
472 mesg = define_string(doc, varname, valstring, units)
473 else
474 mesg = define_string(doc, varname, valstring, "[days : seconds]")
475 endif
476
477 equalsdefault = .false.
478 if (present(like_default)) equalsdefault = like_default
479 if (present(default)) then
480 if (val == default) equalsdefault = .true.
481 mesg = trim(mesg)//" default = "//trim(time_string(default))
482 endif
483
484 if (mesghasbeendocumented(doc, varname, mesg)) return ! Avoid duplicates
485 call writemessageanddesc(doc, mesg, desc, equalsdefault, debuggingparam=debuggingparam)
486 endif
487
488end subroutine doc_param_time
489
490!> This subroutine writes out the message and description to the documentation files.
491subroutine writemessageanddesc(doc, vmesg, desc, valueWasDefault, indent, &
492 layoutParam, debuggingParam)
493 type(doc_type), intent(in) :: doc !< A pointer to a structure that controls where the
494 !! documentation occurs and its formatting
495 character(len=*), intent(in) :: vmesg !< A message with the parameter name, units, and default value.
496 character(len=*), intent(in) :: desc !< A description of the parameter being documented
497 logical, optional, intent(in) :: valueWasDefault !< If true, this parameter has its default value
498 integer, optional, intent(in) :: indent !< An amount by which to indent this message
499 logical, optional, intent(in) :: layoutParam !< If present and true, this is a layout parameter.
500 logical, optional, intent(in) :: debuggingParam !< If present and true, this is a debugging parameter.
501
502 ! Local variables
503 character(len=mLen) :: mesg ! A full line of a message including indents.
504 character(len=mLen) :: mesg_text ! A line of message text without preliminary indents.
505 integer :: start_ind = 1 ! The starting index in the description for the next line.
506 integer :: nl_ind, tab_ind, end_ind ! The indices of new-lines, tabs, and the end of a line.
507 integer :: len_text, len_tab, len_nl ! The lengths of the text string, tabs and new-lines.
508 integer :: len_cor ! The permitted length corrected for tab sizes in a line.
509 integer :: len_desc ! The non-whitespace length of the description.
510 integer :: substr_start ! The starting index of a substring to search for tabs.
511 integer :: indnt, msg_pad ! Space counts used to format a message.
512 logical :: msg_done, reset_msg_pad ! Logicals used to format messages.
513 logical :: all, short, layout, debug ! Flags indicating which files to write into.
514
515 layout = .false. ; if (present(layoutparam)) layout = layoutparam
516 debug = .false. ; if (present(debuggingparam)) debug = debuggingparam
517 all = doc%complete .and. (doc%unitAll > 0) .and. .not. (layout .or. debug)
518 short = doc%minimal .and. (doc%unitShort > 0) .and. .not. (layout .or. debug)
519 if (present(valuewasdefault)) short = short .and. (.not. valuewasdefault)
520
521 if (all) write(doc%unitAll, '(a)') trim(vmesg)
522 if (short) write(doc%unitShort, '(a)') trim(vmesg)
523 if (layout) write(doc%unitLayout, '(a)') trim(vmesg)
524 if (debug) write(doc%unitDebugging, '(a)') trim(vmesg)
525
526 if (len_trim(desc) == 0) return
527
528 len_tab = len_trim("_\t_") - 2
529 len_nl = len_trim("_\n_") - 2
530
531 indnt = doc%commentColumn ; if (present(indent)) indnt = indent
532 len_text = doc%max_line_len - (indnt + 2)
533 start_ind = 1 ; msg_pad = 0 ; msg_done = .false.
534 do
535 if (len_trim(desc(start_ind:)) < 1) exit
536
537 len_cor = len_text - msg_pad
538
539 substr_start = start_ind
540 len_desc = len_trim(desc)
541 do ! Adjust the available line length for anomalies in the size of tabs, counting \t as 2 spaces.
542 if (substr_start >= start_ind+len_cor) exit
543 tab_ind = index(desc(substr_start:min(len_desc,start_ind+len_cor)), "\t")
544 if (tab_ind == 0) exit
545 substr_start = substr_start + tab_ind
546 len_cor = len_cor + (len_tab - 2)
547 enddo
548
549 nl_ind = index(desc(start_ind:), "\n")
550 end_ind = 0
551 if ((nl_ind > 0) .and. (len_trim(desc(start_ind:start_ind+nl_ind-2)) > len_cor)) then
552 ! This line is too long despite the new-line character. Look for an earlier space to break.
553 end_ind = scan(desc(start_ind:start_ind+len_cor), " ", back=.true.) - 1
554 if (end_ind > 0) nl_ind = 0
555 elseif ((nl_ind == 0) .and. (len_trim(desc(start_ind:)) > len_cor)) then
556 ! This line is too long and does not have a new-line character. Look for a space to break.
557 end_ind = scan(desc(start_ind:start_ind+len_cor), " ", back=.true.) - 1
558 endif
559
560 reset_msg_pad = .false.
561 if (nl_ind > 0) then
562 mesg_text = trim(desc(start_ind:start_ind+nl_ind-2))
563 start_ind = start_ind + nl_ind + len_nl - 1
564 reset_msg_pad = .true.
565 elseif (end_ind > 0) then
566 mesg_text = trim(desc(start_ind:start_ind+end_ind))
567 start_ind = start_ind + end_ind + 1
568 ! Adjust the starting point to move past leading spaces.
569 start_ind = start_ind + (len_trim(desc(start_ind:)) - len_trim(adjustl(desc(start_ind:))))
570 else
571 mesg_text = trim(desc(start_ind:))
572 msg_done = .true.
573 endif
574
575 do ; tab_ind = index(mesg_text, "\t") ! Replace \t with 2 spaces.
576 if (tab_ind == 0) exit
577 mesg_text(tab_ind:) = " "//trim(mesg_text(tab_ind+len_tab:))
578 enddo
579
580 mesg = repeat(" ",indnt)//"! "//repeat(" ",msg_pad)//trim(mesg_text)
581
582 if (reset_msg_pad) then
583 msg_pad = 0
584 elseif (msg_pad == 0) then ! Indent continuation lines.
585 msg_pad = len_trim(mesg_text) - len_trim(adjustl(mesg_text))
586 ! If already indented, indent an additional 2 spaces.
587 if (msg_pad >= 2) msg_pad = msg_pad + 2
588 endif
589
590 if (all) write(doc%unitAll, '(a)') trim(mesg)
591 if (short) write(doc%unitShort, '(a)') trim(mesg)
592 if (layout) write(doc%unitLayout, '(a)') trim(mesg)
593 if (debug) write(doc%unitDebugging, '(a)') trim(mesg)
594
595 if (msg_done) exit
596 enddo
597
598end subroutine writemessageanddesc
599
600! ----------------------------------------------------------------------
601
602!> This function returns a string with a time type formatted as seconds (perhaps including a
603!! fractional number of seconds) and days
604function time_string(time)
605 type(time_type), intent(in) :: time !< The time type being translated
606 character(len=40) :: time_string
607
608 ! Local variables
609 integer :: secs, days, ticks, ticks_per_sec
610
611 call get_time(time, secs, days, ticks)
612
613 time_string = trim(adjustl(int_string(days))) // ":" // trim(adjustl(int_string(secs)))
614 if (ticks /= 0) then
615 ticks_per_sec = get_ticks_per_second()
616 time_string = trim(time_string) // ":" // &
617 trim(adjustl(int_string(ticks)))//"/"//trim(adjustl(int_string(ticks_per_sec)))
618 endif
619
620end function time_string
621
622!> This function returns a string with a real formatted like '(G)'
623function real_string(val)
624 real, intent(in) :: val !< The value being written into a string
625 character(len=32) :: real_string
626! This function returns a string with a real formatted like '(G)'
627 integer :: len, ind
628
629 if ((abs(val) < 1.0e4) .and. (abs(val) >= 1.0e-3)) then
630 write(real_string, '(F30.11)') val
631 if (.not.testformattedfloatisreal(real_string,val)) then
632 write(real_string, '(F30.12)') val
633 if (.not.testformattedfloatisreal(real_string,val)) then
634 write(real_string, '(F30.13)') val
635 if (.not.testformattedfloatisreal(real_string,val)) then
636 write(real_string, '(F30.14)') val
637 if (.not.testformattedfloatisreal(real_string,val)) then
638 write(real_string, '(F30.15)') val
639 if (.not.testformattedfloatisreal(real_string,val)) then
640 write(real_string, '(F30.16)') val
641 endif
642 endif
643 endif
644 endif
645 endif
646 do
647 len = len_trim(real_string)
648 if ((len<2) .or. (real_string(len-1:len) == ".0") .or. &
649 (real_string(len:len) /= "0")) exit
650 real_string(len:len) = " "
651 enddo
652 elseif (val == 0.) then
653 real_string = "0.0"
654 else
655 if ((abs(val) < 1.0e-99) .or. (abs(val) >= 1.0e100)) then
656 write(real_string(1:32), '(ES24.14E4)') val
657 if (scan(real_string, "eE") == 0) then ! Fix a bug with a missing E in PGI formatting
658 ind = scan(real_string, "-+", back=.true.)
659 if (ind > index(real_string, ".") ) & ! Avoid changing a leading sign.
660 real_string = real_string(1:ind-1)//"E"//real_string(ind:)
661 endif
662 if (.not.testformattedfloatisreal(real_string, val)) then
663 write(real_string(1:32), '(ES25.15E4)') val
664 if (scan(real_string, "eE") == 0) then ! Fix a bug with a missing E in PGI formatting
665 ind = scan(real_string, "-+", back=.true.)
666 if (ind > index(real_string, ".") ) & ! Avoid changing a leading sign.
667 real_string = real_string(1:ind-1)//"E"//real_string(ind:)
668 endif
669 endif
670 ! Remove a leading 0 from the exponent, if it is there.
671 ind = max(index(real_string, "E+0"), index(real_string, "E-0"))
672 if (ind > 0) real_string = real_string(1:ind+1)//real_string(ind+3:)
673 else
674 write(real_string(1:32), '(ES23.14)') val
675 if (.not.testformattedfloatisreal(real_string, val)) &
676 write(real_string(1:32), '(ES23.15)') val
677 endif
678 do ! Remove extra trailing 0s before the exponent.
679 ind = index(real_string, "0E")
680 if (ind == 0) exit
681 if (real_string(ind-1:ind-1) == ".") exit ! Leave at least one digit after the decimal point.
682 real_string = real_string(1:ind-1)//real_string(ind+1:)
683 enddo
684 endif
685 real_string = adjustl(real_string)
686end function real_string
687
688!> Returns a character string of a comma-separated, compact formatted, reals
689!> e.g. "1., 2., 5*3., 5.E2", that give the list of values.
690function real_array_string(vals, sep)
691 character(len=:) ,allocatable :: real_array_string !< The output string listing vals
692 real, intent(in) :: vals(:) !< The array of values to record
693 character(len=*), &
694 optional, intent(in) :: sep !< The separator between successive values,
695 !! by default it is ', '.
696! Returns a character string of a comma-separated, compact formatted, reals
697! e.g. "1., 2., 5*3., 5.E2"
698 ! Local variables
699 integer :: j, n, ns
700 logical :: dowrite
701 character(len=10) :: separator
702 n = 1 ; dowrite = .true. ; real_array_string = ''
703 if (present(sep)) then
704 separator = sep ; ns = len(sep)
705 else
706 separator = ', ' ; ns = 2
707 endif
708 do j=1,size(vals)
709 dowrite = .true.
710 if (j < size(vals)) then
711 if (vals(j) == vals(j+1)) then
712 n = n+1
713 dowrite = .false.
714 endif
715 endif
716 if (dowrite) then
717 if (len(real_array_string) > 0) then ! Write separator if a number has already been written
718 real_array_string = real_array_string // separator(1:ns)
719 endif
720 if (n>1) then
721 real_array_string = real_array_string // trim(int_string(n)) // "*" // trim(real_string(vals(j)))
722 else
724 endif
725 n=1
726 endif
727 enddo
728end function real_array_string
729
730
731!> Returns a character string of a comma-separated, compact formatted, integers
732!> e.g. "1, 2, 7*3, 500", that give the list of values.
733function int_array_string(vals, sep)
734 character(len=:), allocatable :: int_array_string !< The output string listing vals
735 integer, intent(in) :: vals(:) !< The array of values to record
736 character(len=*), &
737 optional, intent(in) :: sep !< The separator between successive values,
738 !! by default it is ', '.
739
740 ! Local variables
741 integer :: j, m, n, ns
742 logical :: dowrite
743 character(len=10) :: separator
744 n = 1 ; dowrite = .true. ; int_array_string = ''
745 if (present(sep)) then
746 separator = sep ; ns = len(sep)
747 else
748 separator = ', ' ; ns = 2
749 endif
750 do j=1,size(vals)
751 dowrite = .true.
752 if (j < size(vals)) then
753 if (vals(j) == vals(j+1)) then
754 n = n+1
755 dowrite = .false.
756 endif
757 endif
758 if (dowrite) then
759 if (len(int_array_string) > 0) then ! Write separator if a number has already been written
760 int_array_string = int_array_string // separator(1:ns)
761 endif
762 if (n>1) then
763 if (size(vals) > 6) then ! The n*val syntax is convenient in long lists of integers.
764 int_array_string = int_array_string // trim(int_string(n)) // "*" // trim(int_string(vals(j)))
765 else ! For short lists of integers, do not use the n*val syntax as it is less convenient.
766 do m=1,n-1
767 int_array_string = int_array_string // trim(int_string(vals(j))) // separator(1:ns)
768 enddo
770 endif
771 else
773 endif
774 n=1
775 endif
776 enddo
777end function int_array_string
778
779!> This function tests whether a real value is encoded in a string.
780function testformattedfloatisreal(str, val)
781 character(len=*), intent(in) :: str !< The string that match val
782 real, intent(in) :: val !< The value being tested
783 logical :: testformattedfloatisreal
784 ! Local variables
785 real :: scannedval
786
787 read(str(1:),*) scannedval
788 if (scannedval == val) then
790 else
792 endif
793end function testformattedfloatisreal
794
795!> This function returns a string with an integer formatted like '(I)'
796function int_string(val)
797 integer, intent(in) :: val !< The value being written into a string
798 character(len=24) :: int_string
799! This function returns a string with an integer formatted like '(I)'
800 write(int_string, '(i24)') val
801 int_string = adjustl(int_string)
802end function int_string
803
804!> This function returns a string with an logical formatted like '(L)'
805function logical_string(val)
806 logical, intent(in) :: val !< The value being written into a string
807 character(len=24) :: logical_string
808! This function returns a string with an logical formatted like '(L)'
809 write(logical_string, '(l24)') val
811end function logical_string
812
813!> This function returns a string for formatted parameter assignment
814function define_string(doc, varName, valString, units)
815 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
816 !! documentation occurs and its formatting
817 character(len=*), intent(in) :: varname !< The name of the parameter being documented
818 character(len=*), intent(in) :: valstring !< A string containing the value of the parameter
819 character(len=*), intent(in) :: units !< The units of the parameter being documented
820 character(len=mLen) :: define_string
821! This function returns a string for formatted parameter assignment
822 integer :: numspaces
823 define_string = repeat(" ",mlen) ! Blank everything for safety
824 if (doc%defineSyntax) then
825 define_string = "#define "//trim(varname)//" "//valstring
826 else
827 define_string = trim(varname)//" = "//valstring
828 endif
829 numspaces = max(1, doc%commentColumn - len_trim(define_string) )
830 define_string = trim(define_string)//repeat(" ",numspaces)//"!"
831 if (len_trim(units) > 0) define_string = trim(define_string)//" ["//trim(units)//"]"
832end function define_string
833
834!> This function returns a string for formatted false logicals
835function undef_string(doc, varName, units)
836 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
837 !! documentation occurs and its formatting
838 character(len=*), intent(in) :: varname !< The name of the parameter being documented
839 character(len=*), intent(in) :: units !< The units of the parameter being documented
840 character(len=mLen) :: undef_string
841! This function returns a string for formatted false logicals
842 integer :: numspaces
843 undef_string = repeat(" ",240) ! Blank everything for safety
844 undef_string = "#undef "//trim(varname)
845 if (doc%defineSyntax) then
846 undef_string = "#undef "//trim(varname)
847 else
848 undef_string = trim(varname)//" = "//string_false
849 endif
850 numspaces = max(1, doc%commentColumn - len_trim(undef_string) )
851 undef_string = trim(undef_string)//repeat(" ",numspaces)//"!"
852 if (len_trim(units) > 0) undef_string = trim(undef_string)//" ["//trim(units)//"]"
853end function undef_string
854
855! ----------------------------------------------------------------------
856
857!> This subroutine handles the module documentation
858subroutine doc_module(doc, modname, desc, log_to_all, all_default, layoutMod, debuggingMod)
859 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
860 !! documentation occurs and its formatting
861 character(len=*), intent(in) :: modname !< The name of the module being documented
862 character(len=*), intent(in) :: desc !< A description of the module being documented
863 logical, optional, intent(in) :: log_to_all !< If present and true, log this parameter to the
864 !! ..._doc.all files, even if this module also has layout
865 !! or debugging parameters.
866 logical, optional, intent(in) :: all_default !< If true, all parameters take their default values.
867 logical, optional, intent(in) :: layoutmod !< If present and true, this module has layout parameters.
868 logical, optional, intent(in) :: debuggingmod !< If present and true, this module has debugging parameters.
869
870 ! This subroutine handles the module documentation
871 character(len=mLen) :: mesg
872 logical :: repeat_doc
873
874 if (.not. (is_root_pe() .and. associated(doc))) return
875 call open_doc_file(doc)
876
877 if (doc%filesAreOpen) then
878 ! Add a blank line for delineation
879 call writemessageanddesc(doc, '', '', valuewasdefault=all_default, &
880 layoutparam=layoutmod, debuggingparam=debuggingmod)
881 mesg = "! === module "//trim(modname)//" ==="
882 call writemessageanddesc(doc, mesg, desc, valuewasdefault=all_default, indent=0, &
883 layoutparam=layoutmod, debuggingparam=debuggingmod)
884 if (present(log_to_all)) then ; if (log_to_all) then
885 ! Log the module version again if the previous call was intercepted for use to document
886 ! a layout or debugging module.
887 repeat_doc = .false.
888 if (present(layoutmod)) then ; if (layoutmod) repeat_doc = .true. ; endif
889 if (present(debuggingmod)) then ; if (debuggingmod) repeat_doc = .true. ; endif
890 if (repeat_doc) then
891 call writemessageanddesc(doc, '', '', valuewasdefault=all_default)
892 call writemessageanddesc(doc, mesg, desc, valuewasdefault=all_default, indent=0)
893 endif
894 endif ; endif
895 endif
896end subroutine doc_module
897
898!> This subroutine handles the subroutine documentation
899subroutine doc_subroutine(doc, modname, subname, desc)
900 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
901 !! documentation occurs and its formatting
902 character(len=*), intent(in) :: modname !< The name of the module being documented
903 character(len=*), intent(in) :: subname !< The name of the subroutine being documented
904 character(len=*), intent(in) :: desc !< A description of the subroutine being documented
905! This subroutine handles the subroutine documentation
906 if (.not. (is_root_pe() .and. associated(doc))) return
907 call open_doc_file(doc)
908
909end subroutine doc_subroutine
910
911!> This subroutine handles the function documentation
912subroutine doc_function(doc, modname, fnname, desc)
913 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
914 !! documentation occurs and its formatting
915 character(len=*), intent(in) :: modname !< The name of the module being documented
916 character(len=*), intent(in) :: fnname !< The name of the function being documented
917 character(len=*), intent(in) :: desc !< A description of the function being documented
918! This subroutine handles the function documentation
919 if (.not. (is_root_pe() .and. associated(doc))) return
920 call open_doc_file(doc)
921
922end subroutine doc_function
923
924! ----------------------------------------------------------------------
925
926!> Initialize the parameter documentation
927subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging)
928 character(len=*), intent(in) :: docfilebase !< The base file name for this set of parameters,
929 !! for example MOM_parameter_doc
930 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
931 !! documentation occurs and its formatting
932 logical, optional, intent(in) :: minimal !< If present and true, write out the files (.short) documenting
933 !! those parameters that do not take on their default values.
934 logical, optional, intent(in) :: complete !< If present and true, write out the (.all) files documenting all
935 !! parameters
936 logical, optional, intent(in) :: layout !< If present and true, write out the (.layout) files documenting
937 !! the layout parameters
938 logical, optional, intent(in) :: debugging !< If present and true, write out the (.debugging) files documenting
939 !! the debugging parameters
940
941 if (.not. associated(doc)) then
942 allocate(doc)
943 endif
944
945 doc%docFileBase = docfilebase
946 if (present(minimal)) doc%minimal = minimal
947 if (present(complete)) doc%complete = complete
948 if (present(layout)) doc%layout = layout
949 if (present(debugging)) doc%debugging = debugging
950
951end subroutine doc_init
952
953!> This subroutine allocates and populates a structure that controls where the
954!! documentation occurs and its formatting, and opens up the files controlled
955!! by this structure
956subroutine open_doc_file(doc)
957 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
958 !! documentation occurs and its formatting
959
960 logical :: opened, new_file
961 integer :: ios
962 character(len=240) :: fileName
963
964 if (.not. (is_root_pe() .and. associated(doc))) return
965
966 if ((len_trim(doc%docFileBase) > 0) .and. doc%complete .and. (doc%unitAll<0)) then
967 new_file = .true. ; if (doc%unitAll /= -1) new_file = .false.
968 doc%unitAll = find_unused_unit_number()
969
970 write(filename(1:240),'(a)') trim(doc%docFileBase)//'.all'
971 if (new_file) then
972 open(doc%unitAll, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
973 action='WRITE', status='REPLACE', iostat=ios)
974 write(doc%unitAll, '(a)') &
975 '! This file was written by the model and records all non-layout '//&
976 'or debugging parameters used at run-time.'
977 else ! This file is being reopened, and should be appended.
978 open(doc%unitAll, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
979 action='WRITE', status='OLD', position='APPEND', iostat=ios)
980 endif
981 inquire(doc%unitAll, opened=opened)
982 if ((.not.opened) .or. (ios /= 0)) then
983 call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
984 endif
985 doc%filesAreOpen = .true.
986 endif
987
988 if ((len_trim(doc%docFileBase) > 0) .and. doc%minimal .and. (doc%unitShort<0)) then
989 new_file = .true. ; if (doc%unitShort /= -1) new_file = .false.
990 doc%unitShort = find_unused_unit_number()
991
992 write(filename(1:240),'(a)') trim(doc%docFileBase)//'.short'
993 if (new_file) then
994 open(doc%unitShort, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
995 action='WRITE', status='REPLACE', iostat=ios)
996 write(doc%unitShort, '(a)') &
997 '! This file was written by the model and records the non-default parameters used at run-time.'
998 else ! This file is being reopened, and should be appended.
999 open(doc%unitShort, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
1000 action='WRITE', status='OLD', position='APPEND', iostat=ios)
1001 endif
1002 inquire(doc%unitShort, opened=opened)
1003 if ((.not.opened) .or. (ios /= 0)) then
1004 call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
1005 endif
1006 doc%filesAreOpen = .true.
1007 endif
1008
1009 if ((len_trim(doc%docFileBase) > 0) .and. doc%layout .and. (doc%unitLayout<0)) then
1010 new_file = .true. ; if (doc%unitLayout /= -1) new_file = .false.
1011 doc%unitLayout = find_unused_unit_number()
1012
1013 write(filename(1:240),'(a)') trim(doc%docFileBase)//'.layout'
1014 if (new_file) then
1015 open(doc%unitLayout, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
1016 action='WRITE', status='REPLACE', iostat=ios)
1017 write(doc%unitLayout, '(a)') &
1018 '! This file was written by the model and records the layout parameters used at run-time.'
1019 else ! This file is being reopened, and should be appended.
1020 open(doc%unitLayout, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
1021 action='WRITE', status='OLD', position='APPEND', iostat=ios)
1022 endif
1023 inquire(doc%unitLayout, opened=opened)
1024 if ((.not.opened) .or. (ios /= 0)) then
1025 call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
1026 endif
1027 doc%filesAreOpen = .true.
1028 endif
1029
1030 if ((len_trim(doc%docFileBase) > 0) .and. doc%debugging .and. (doc%unitDebugging<0)) then
1031 new_file = .true. ; if (doc%unitDebugging /= -1) new_file = .false.
1032 doc%unitDebugging = find_unused_unit_number()
1033
1034 write(filename(1:240),'(a)') trim(doc%docFileBase)//'.debugging'
1035 if (new_file) then
1036 open(doc%unitDebugging, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
1037 action='WRITE', status='REPLACE', iostat=ios)
1038 write(doc%unitDebugging, '(a)') &
1039 '! This file was written by the model and records the debugging parameters used at run-time.'
1040 else ! This file is being reopened, and should be appended.
1041 open(doc%unitDebugging, file=trim(filename), access='SEQUENTIAL', form='FORMATTED', &
1042 action='WRITE', status='OLD', position='APPEND', iostat=ios)
1043 endif
1044 inquire(doc%unitDebugging, opened=opened)
1045 if ((.not.opened) .or. (ios /= 0)) then
1046 call mom_error(fatal, "Failed to open doc file "//trim(filename)//".")
1047 endif
1048 doc%filesAreOpen = .true.
1049 endif
1050
1051end subroutine open_doc_file
1052
1053!> Find an unused unit number, returning >0 if found, and triggering a FATAL error if not.
1054function find_unused_unit_number()
1055! Find an unused unit number.
1056! Returns >0 if found. FATAL if not.
1057 integer :: find_unused_unit_number
1058 logical :: opened
1059 do find_unused_unit_number=512,42,-1
1060 inquire( find_unused_unit_number, opened=opened)
1061 if (.not.opened) exit
1062 enddo
1063 if (opened) call mom_error(fatal, &
1064 "doc_init failed to find an unused unit number.")
1065end function find_unused_unit_number
1066
1067!> This subroutine closes the files controlled by doc, and sets flags in
1068!! doc to indicate that parameterization is no longer permitted.
1069subroutine doc_end(doc)
1070 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
1071 !! documentation occurs and its formatting
1072 type(link_msg), pointer :: this => null(), next => null()
1073
1074 if (.not.associated(doc)) return
1075
1076 if (doc%unitAll > 0) then
1077 close(doc%unitAll)
1078 doc%unitAll = -2
1079 endif
1080
1081 if (doc%unitShort > 0) then
1082 close(doc%unitShort)
1083 doc%unitShort = -2
1084 endif
1085
1086 if (doc%unitLayout > 0) then
1087 close(doc%unitLayout)
1088 doc%unitLayout = -2
1089 endif
1090
1091 if (doc%unitDebugging > 0) then
1092 close(doc%unitDebugging)
1093 doc%unitDebugging = -2
1094 endif
1095
1096 doc%filesAreOpen = .false.
1097
1098 this => doc%chain_msg
1099 do while( associated(this) )
1100 next => this%next
1101 deallocate(this)
1102 this => next
1103 enddo
1104end subroutine doc_end
1105
1106! -----------------------------------------------------------------------------
1107
1108!> Returns true if documentation has already been written
1109function mesghasbeendocumented(doc,varName,mesg)
1110 type(doc_type), pointer :: doc !< A pointer to a structure that controls where the
1111 !! documentation occurs and its formatting
1112 character(len=*), intent(in) :: varname !< The name of the parameter being documented
1113 character(len=*), intent(in) :: mesg !< A message with parameter values, defaults, and descriptions
1114 !! to compare with the message that was written previously
1115 logical :: mesghasbeendocumented
1116! Returns true if documentation has already been written
1117 type(link_msg), pointer :: newlink => null(), this => null(), last => null()
1118
1119 mesghasbeendocumented = .false.
1120
1121!!if (mesg(1:1) == '!') return ! Ignore commented parameters
1122
1123 ! Search through list for this parameter
1124 last => null()
1125 this => doc%chain_msg
1126 do while( associated(this) )
1127 if (trim(doc%blockPrefix)//trim(varname) == trim(this%name)) then
1128 mesghasbeendocumented = .true.
1129 if (trim(mesg) == trim(this%msg)) return
1130 ! If we fail the above test then cause an error
1131 if (mesg(1:1) == '!') return ! Do not cause error for commented parameters
1132 call mom_error(warning, "Previous msg:"//trim(this%msg))
1133 call mom_error(warning, "New message :"//trim(mesg))
1134 call mom_error(warning, "Encountered inconsistent documentation line for parameter "&
1135 //trim(varname)//"!")
1136 endif
1137 last => this
1138 this => this%next
1139 enddo
1140
1141 ! Allocate a new link
1142 allocate(newlink)
1143 newlink%name = trim(doc%blockPrefix)//trim(varname)
1144 newlink%msg = trim(mesg)
1145 newlink%next => null()
1146 if (.not. associated(doc%chain_msg)) then
1147 doc%chain_msg => newlink
1148 else
1149 if (.not. associated(last)) call mom_error(fatal, &
1150 "Unassociated LINK in mesgHasBeenDocumented: "//trim(mesg))
1151 last%next => newlink
1152 endif
1153end function mesghasbeendocumented
1154
1155end module mom_document