src/framework/MOM_file_parser.F90

portedportable, not yet portedexecuted, not portableexecutable, not hit by this run

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 MOM6 facility to parse input files for runtime parameters
6		module MOM_file_parser
7
8		use MOM_coms, only : root_PE, broadcast
9		use MOM_coms, only : any_across_PEs
10		use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, assert
11		use MOM_error_handler, only : is_root_pe, stdlog, stdout
12		use MOM_time_manager, only : get_time, time_type, get_ticks_per_second
13		use MOM_time_manager, only : set_date, get_date, real_to_time, operator(-), operator(==), set_time
14		use MOM_document, only : doc_param, doc_module, doc_init, doc_end, doc_type
15		use MOM_document, only : doc_openBlock, doc_closeBlock
16		use MOM_string_functions, only : left_int, left_ints, slasher
17		use MOM_string_functions, only : left_real, left_reals
18
19		implicit none ; private
20
21		! These are hard-coded limits that are used in the following code. They should be set
22		! generously enough not to impose any significant limitations.
23		integer, parameter, public :: MAX_PARAM_FILES = 5 !< Maximum number of parameter files.
24		integer, parameter :: INPUT_STR_LENGTH = 1024 !< Maximum line length in parameter file. Lines that
25		!! are combined by ending in '\' or '&' can exceed
26		!! this limit after merging.
27		integer, parameter :: FILENAME_LENGTH = 200 !< Maximum number of characters in file names.
28
29
30		!>@{ Default values for parameters
31		logical, parameter :: report_unused_default = .true.
32		logical, parameter :: unused_params_fatal_default = .false.
33		logical, parameter :: log_to_stdout_default = .false.
34		logical, parameter :: complete_doc_default = .true.
35		logical, parameter :: minimal_doc_default = .true.
36		!>@}
37
38
39		!> A simple type to allow lines in an array to be allocated with variable sizes.
40		type, private :: file_line_type ; private
41		character(len=:), allocatable :: line !< An allocatable line with content
42		end type file_line_type
43
44		!> The valid lines extracted from an input parameter file without comments
45		type, private :: file_data_type ; private
46		integer :: num_lines = 0 !< The number of lines in this type
47		type(file_line_type), allocatable, dimension(:) :: fln !< Lines with the input content.
48		logical, pointer, dimension(:) :: line_used => NULL() !< If true, the line has been read
49		end type file_data_type
50
51		!> A link in the list of variables that have already had override warnings issued
52		type, private :: link_parameter ; private
53		type(link_parameter), pointer :: next => NULL() !< Facilitates linked list
54		character(len=80) :: name !< Parameter name
55		logical :: hasIssuedOverrideWarning = .false. !< Has a default value
56		end type link_parameter
57
58		!> Specify the active parameter block
59		type, private :: parameter_block ; private
60		character(len=240) :: name = '' !< The active parameter block name
61		logical :: log_access = .true.
62		!< Log the entry and exit of the block (but not its contents)
63		end type parameter_block
64
65		!> A structure that can be parsed to read and document run-time parameters.
66		type, public :: param_file_type ; private
67		integer :: nfiles = 0 !< The number of open files.
68		integer :: iounit(MAX_PARAM_FILES) !< The unit numbers of open files.
69		character(len=FILENAME_LENGTH) :: filename(MAX_PARAM_FILES) !< The names of the open files.
70		logical :: NetCDF_file(MAX_PARAM_FILES) !< If true, the input file is in NetCDF.
71		! This is not yet implemented.
72		type(file_data_type) :: param_data(MAX_PARAM_FILES) !< Structures that contain
73		!! the valid data lines from the parameter
74		!! files, enabling all subsequent reads of
75		!! parameter data to occur internally.
76		logical :: report_unused = report_unused_default !< If true, report any
77		!! parameter lines that are not used in the run.
78		logical :: unused_params_fatal = unused_params_fatal_default !< If true, kill
79		!! the run if there are any unused parameters.
80		logical :: log_to_stdout = log_to_stdout_default !< If true, all log
81		!! messages are also sent to stdout.
82		logical :: log_open = .false. !< True if the log file has been opened.
83		integer :: max_line_len = 4 !< The maximum number of characters in the lines
84		!! in any of the files in this param_file_type after
85		!! any continued lines have been combined.
86		integer :: stdout !< The unit number from stdout().
87		integer :: stdlog !< The unit number from stdlog().
88		character(len=240) :: doc_file !< A file where all run-time parameters, their
89		!! settings and defaults are documented.
90		logical :: complete_doc = complete_doc_default !< If true, document all
91		!! run-time parameters.
92		logical :: minimal_doc = minimal_doc_default !< If true, document only those
93		!! run-time parameters that differ from defaults.
94		type(doc_type), pointer :: doc => NULL() !< A structure that contains information
95		!! related to parameter documentation.
96		type(link_parameter), pointer :: chain => NULL() !< Facilitates linked list
97		type(parameter_block), pointer :: blockName => NULL() !< Name of active parameter block
98		end type param_file_type
99
100		public read_param, open_param_file, close_param_file, log_param, log_version
101		public doc_param, get_param
102		public clearParameterBlock, openParameterBlock, closeParameterBlock
103
104		!> An overloaded interface to read various types of parameters
105		interface read_param
106		module procedure read_param_int, read_param_real, read_param_logical, &
107		read_param_char, read_param_char_array, read_param_time, &
108		read_param_int_array, read_param_real_array
109		end interface
110		!> An overloaded interface to log the values of various types of parameters
111		interface log_param
112		module procedure log_param_int, log_param_real, log_param_logical, &
113		log_param_char, log_param_time, &
114		log_param_int_array, log_param_real_array
115		end interface
116		!> An overloaded interface to read and log the values of various types of parameters
117		interface get_param
118		module procedure get_param_int, get_param_real, get_param_logical, &
119		get_param_char, get_param_char_array, get_param_time, &
120		get_param_int_array, get_param_real_array
121		end interface
122
123		!> An overloaded interface to log version information about modules
124		interface log_version
125		module procedure log_version_cs, log_version_plain
126		end interface
127
128		contains
129
130		!> Make the contents of a parameter input file available in a param_file_type
131	2	subroutine open_param_file(filename, CS, checkable, component, doc_file_dir, ensemble_num)
132		character(len=*), intent(in) :: filename !< An input file name, optionally with the full path
133		type(param_file_type), intent(inout) :: CS !< The control structure for the file_parser module,
134		!! it is also a structure to parse for run-time parameters
135		logical, optional, intent(in) :: checkable !< If this is false, it disables checks of this
136		!! file for unused parameters. The default is True.
137		character(len=*), optional, intent(in) :: component !< If present, this component name is used
138		!! to generate parameter documentation file names; the default is"MOM"
139		character(len=*), optional, intent(in) :: doc_file_dir !< An optional directory in which to write out
140		!! the documentation files. The default is effectively './'.
141		integer, optional, intent(in) :: ensemble_num !< ensemble number to be appended to _doc filenames (optional)
142
143		! Local variables
144		logical :: file_exists, Netcdf_file, may_check, reopened_file
145		integer :: ios, iounit, strlen, i
146		character(len=240) :: doc_path
147		character(len=5) :: ensemble_suffix
148		type(parameter_block), pointer :: block => NULL()
149
150	0	may_check = .true. ; if (present(checkable)) may_check = checkable
151
152		! Check for non-blank filename
153	2	strlen = len_trim(filename)
154	2	if (strlen == 0) then
155	0	call MOM_error(FATAL, "open_param_file: Input file has not been specified.")
156		endif
157
158		! Check that this file has not already been opened
159	2	if (CS%nfiles > 0) then
160	1	reopened_file = .false.
161
162	1	if (is_root_pe()) then
163	1	inquire(file=trim(filename), number=iounit)
164	1	if (iounit /= -1) then
165	0	do i = 1, CS%nfiles
166	0	if (CS%iounit(i) == iounit) then
167		call assert(trim(CS%filename(1)) == trim(filename), &
168		"open_param_file: internal inconsistency! "//trim(filename)// &
169	0	" is registered as open but has the wrong unit number!")
170		call MOM_error(WARNING, &
171		"open_param_file: file "//trim(filename)// &
172		" has already been opened. This should NOT happen!"// &
173	0	" Did you specify the same file twice in a namelist?")
174	0	reopened_file = .true.
175		endif ! unit numbers
176		enddo ! i
177		endif
178		endif
179
180	1	if (any_across_PEs(reopened_file)) return
181		endif
182
183		! Check that the file exists to readstdlog
184	2	if (is_root_pe()) then
185	2	inquire(file=trim(filename), exist=file_exists)
186	2	if (.not.file_exists) call MOM_error(FATAL, &
187	0	"open_param_file: Input file '"// trim(filename)//"' does not exist.")
188		endif
189
190	2	Netcdf_file = .false.
191	2	if (strlen > 3) then
192	2	if (filename(strlen-2:strlen) == ".nc") Netcdf_file = .true.
193		endif
194
195	2	if (Netcdf_file) &
196	0	call MOM_error(FATAL,"open_param_file: NetCDF files are not yet supported.")
197
198	2	if (is_root_pe()) then
199		open(newunit=iounit, file=trim(filename), access='SEQUENTIAL', &
200	2	form='FORMATTED', action='READ', position='REWIND', iostat=ios)
201	2	if (ios /= 0) call MOM_error(FATAL, "open_param_file: Error opening '"//trim(filename)//"'.")
202		else
203	0	iounit = 1
204		endif
205
206		! Store/register the unit and details
207	2	i = CS%nfiles + 1
208	2	CS%nfiles = i
209	2	CS%iounit(i) = iounit
210	2	CS%filename(i) = filename
211	2	CS%NetCDF_file(i) = Netcdf_file
212
213	2	if (associated(CS%blockName)) deallocate(CS%blockName)
214	2	allocate(block) ; block%name = '' ; CS%blockName => block
215
216	2	call MOM_mesg("open_param_file: "// trim(filename)//" has been opened successfully.", 5)
217
218	2	call populate_param_data(iounit, filename, CS%param_data(i))
219		! Increment the maximum line length, but always report values in blocks of 4 characters.
220	2	CS%max_line_len = max(CS%max_line_len, 4 + 4*(max_input_line_length(CS, i) - 1) / 4)
221
222	2	call read_param(CS,"SEND_LOG_TO_STDOUT",CS%log_to_stdout)
223	2	call read_param(CS,"REPORT_UNUSED_PARAMS",CS%report_unused)
224	2	call read_param(CS,"FATAL_UNUSED_PARAMS",CS%unused_params_fatal)
225	2	CS%doc_file = "MOM_parameter_doc"
226	2	if (present(ensemble_num)) then
227		! append instance suffix to doc_file
228	0	write(ensemble_suffix,'(A,I0.4)') '_', ensemble_num
229	0	CS%doc_file = trim(CS%doc_file)//ensemble_suffix
230		endif
231	2	if (present(component)) CS%doc_file = trim(component)//"_parameter_doc"
232	2	call read_param(CS,"DOCUMENT_FILE", CS%doc_file)
233	2	if (.not.may_check) then
234	0	CS%report_unused = .false.
235	0	CS%unused_params_fatal = .false.
236		endif
237
238		! Open the log file.
239	2	CS%stdlog = stdlog() ; CS%stdout = stdout()
240	2	CS%log_open = (stdlog() > 0)
241
242	2	doc_path = CS%doc_file
243	2	if (len_trim(CS%doc_file) > 0) then
244	2	CS%complete_doc = complete_doc_default
245	2	call read_param(CS, "COMPLETE_DOCUMENTATION", CS%complete_doc)
246	2	CS%minimal_doc = minimal_doc_default
247	2	call read_param(CS, "MINIMAL_DOCUMENTATION", CS%minimal_doc)
248	2	if (present(doc_file_dir)) then ; if (len_trim(doc_file_dir) > 0) then
249	2	doc_path = trim(slasher(doc_file_dir))//trim(CS%doc_file)
250		endif ; endif
251		else
252	0	CS%complete_doc = .false.
253	0	CS%minimal_doc = .false.
254		endif
255		call doc_init(doc_path, CS%doc, minimal=CS%minimal_doc, complete=CS%complete_doc, &
256	2	layout=CS%complete_doc, debugging=CS%complete_doc)
257
258	2	end subroutine open_param_file
259
260		!> Close any open input files and deallocate memory associated with this param_file_type.
261		!! To use this type again, open_param_file would have to be called again.
262	1	subroutine close_param_file(CS, quiet_close, component)
263		type(param_file_type), intent(inout) :: CS !< The control structure for the file_parser module,
264		!! it is also a structure to parse for run-time parameters
265		logical, optional, intent(in) :: quiet_close !< if present and true, do not do any
266		!! logging with this call.
267		character(len=*), optional, intent(in) :: component !< If present, this component name is used
268		!! to generate parameter documentation file names
269		! Local variables
270		logical :: all_default
271		character(len=128) :: docfile_default
272		character(len=40) :: mdl ! This module's name.
273		! This include declares and sets the variable "version".
274		# include "version_variable.h"
275		integer :: i, n, num_unused
276
277	0	if (present(quiet_close)) then ; if (quiet_close) then
278	0	do i = 1, CS%nfiles
279	0	if (is_root_pe()) close(CS%iounit(i))
280		call MOM_mesg("close_param_file: "// trim(CS%filename(i))// &
281	0	" has been closed successfully.", 5)
282	0	CS%iounit(i) = -1
283	0	CS%filename(i) = ''
284	0	CS%NetCDF_file(i) = .false.
285	0	do n=1,CS%param_data(i)%num_lines ; deallocate(CS%param_data(i)%fln(n)%line) ; enddo
286	0	deallocate (CS%param_data(i)%fln)
287	0	deallocate (CS%param_data(i)%line_used)
288		enddo
289	0	CS%log_open = .false.
290	0	call doc_end(CS%doc)
291	0	deallocate(CS%doc)
292	0	return
293		endif ; endif
294
295		! Log the parameters for the parser.
296	1	docfile_default = "MOM_parameter_doc"
297	1	if (present(component)) docfile_default = trim(component)//"_parameter_doc"
298
299	1	all_default = (CS%log_to_stdout .eqv. log_to_stdout_default)
300	1	all_default = all_default .and. (trim(CS%doc_file) == trim(docfile_default))
301	1	if (len_trim(CS%doc_file) > 0) then
302	1	all_default = all_default .and. (CS%complete_doc .eqv. complete_doc_default)
303	1	all_default = all_default .and. (CS%minimal_doc .eqv. minimal_doc_default)
304		endif
305
306	1	mdl = "MOM_file_parser"
307	1	call log_version(CS, mdl, version, "", debugging=.true., log_to_all=.true., all_default=all_default)
308		call log_param(CS, mdl, "SEND_LOG_TO_STDOUT", CS%log_to_stdout, &
309		"If true, all log messages are also sent to stdout.", &
310	1	default=log_to_stdout_default)
311		call log_param(CS, mdl, "REPORT_UNUSED_PARAMS", CS%report_unused, &
312		"If true, report any parameter lines that are not used "//&
313		"in the run.", default=report_unused_default, &
314	1	debuggingParam=.true.)
315		call log_param(CS, mdl, "FATAL_UNUSED_PARAMS", CS%unused_params_fatal, &
316		"If true, kill the run if there are any unused "//&
317		"parameters.", default=unused_params_fatal_default, &
318	1	debuggingParam=.true.)
319		call log_param(CS, mdl, "DOCUMENT_FILE", CS%doc_file, &
320		"The basename for files where run-time parameters, their "//&
321		"settings, units and defaults are documented. Blank will "//&
322	1	"disable all parameter documentation.", default=docfile_default)
323	1	if (len_trim(CS%doc_file) > 0) then
324		call log_param(CS, mdl, "COMPLETE_DOCUMENTATION", CS%complete_doc, &
325		"If true, all run-time parameters are "//&
326		"documented in "//trim(CS%doc_file)//&
327	1	".all .", default=complete_doc_default)
328		call log_param(CS, mdl, "MINIMAL_DOCUMENTATION", CS%minimal_doc, &
329		"If true, non-default run-time parameters are "//&
330		"documented in "//trim(CS%doc_file)//&
331	1	".short .", default=minimal_doc_default)
332		endif
333
334	1	num_unused = 0
335	3	do i = 1, CS%nfiles
336	2	if (is_root_pe() .and. (CS%report_unused .or. &
337		CS%unused_params_fatal)) then
338		! Check for unused lines.
339	127	do n=1,CS%param_data(i)%num_lines
340	127	if (.not.CS%param_data(i)%line_used(n)) then
341	0	num_unused = num_unused + 1
342	0	if (CS%report_unused) &
343		call MOM_error(WARNING, "Unused line in "//trim(CS%filename(i))// &
344	0	" : "//trim(CS%param_data(i)%fln(n)%line))
345		endif
346		enddo
347		endif
348
349	2	if (is_root_pe()) close(CS%iounit(i))
350	2	call MOM_mesg("close_param_file: "// trim(CS%filename(i))//" has been closed successfully.", 5)
351	2	CS%iounit(i) = -1
352	2	CS%filename(i) = ''
353	2	CS%NetCDF_file(i) = .false.
354	127	do n=1,CS%param_data(i)%num_lines ; deallocate(CS%param_data(i)%fln(n)%line) ; enddo
355	129	deallocate (CS%param_data(i)%fln)
356	3	deallocate (CS%param_data(i)%line_used)
357		enddo
358	1	deallocate(CS%blockName)
359
360	1	if (is_root_pe() .and. (num_unused>0) .and. CS%unused_params_fatal) &
361	0	call MOM_error(FATAL, "Run stopped because of unused parameter lines.")
362
363	1	CS%log_open = .false.
364	1	call doc_end(CS%doc)
365	1	deallocate(CS%doc)
366	1	end subroutine close_param_file
367
368		!> Read the contents of a parameter input file, and store the contents in a
369		!! file_data_type after removing comments and simplifying white space
370	2	subroutine populate_param_data(iounit, filename, param_data)
371		integer, intent(in) :: iounit !< The IO unit number that is open for filename
372		character(len=*), intent(in) :: filename !< An input file name, optionally with the full path
373		type(file_data_type), intent(inout) :: param_data !< A list of the input lines that set parameters
374		!! after comments have been stripped out.
375
376		! Local variables
377		character(len=INPUT_STR_LENGTH) :: line
378	2	character(len=1), allocatable, dimension(:) :: char_buf
379	2	integer, allocatable, dimension(:) :: line_len ! The trimmed length of each processed input line
380		integer :: n, num_lines, total_chars, ch, rsc, llen, int_buf(2)
381		logical :: inMultiLineComment
382
383		! Find the number of keyword lines in a parameter file
384	2	if (is_root_pe()) then
385		! rewind the parameter file
386	2	rewind(iounit)
387
388		! count the number of valid entries in the parameter file
389	2	num_lines = 0
390	2	total_chars = 0
391	2	inMultiLineComment = .false.
392	576	do while(.true.)
393	578	read(iounit, '(a)', end=8) line
394	576	line = replaceTabs(line)
395	576	if (inMultiLineComment) then
396	0	if (closeMultiLineComment(line)) inMultiLineComment=.false.
397		else
398	576	if (lastNonCommentNonBlank(line)>0) then
399	125	line = removeComments(line)
400	125	line = simplifyWhiteSpace(line(:len_trim(line)))
401	125	num_lines = num_lines + 1
402	125	total_chars = total_chars + len_trim(line)
403		endif
404	576	if (openMultiLineComment(line)) inMultiLineComment=.true.
405		endif
406		enddo ! while (.true.)
407		8 continue ! get here when read() reaches EOF
408
409	2	if (inMultiLineComment .and. is_root_pe()) &
410		call MOM_error(FATAL, 'MOM_file_parser : A C-style multi-line comment '// &
411	0	'(/* ... */) was not closed before the end of '//trim(filename))
412
413
414	2	int_buf(1) = num_lines
415	2	int_buf(2) = total_chars
416		endif ! (is_root_pe())
417
418		! Broadcast the number of valid entries in parameter file
419	2	call broadcast(int_buf, 2, root_pe())
420	2	num_lines = int_buf(1)
421	2	total_chars = int_buf(2)
422
423		! Set up the space for storing the actual lines.
424	2	param_data%num_lines = num_lines
425	127	allocate (line_len(num_lines), source=0)
426	2612	allocate (char_buf(total_chars), source=" ")
427
428		! Read the actual lines.
429	2	if (is_root_pe()) then
430		! rewind the parameter file
431	2	rewind(iounit)
432
433		! Populate param_data%fln%line
434	2	num_lines = 0
435	2	rsc = 0
436	576	do while(.true.)
437	578	read(iounit, '(a)', end=18) line
438	576	line = replaceTabs(line)
439	576	if (inMultiLineComment) then
440	0	if (closeMultiLineComment(line)) inMultiLineComment=.false.
441		else
442	576	if (lastNonCommentNonBlank(line)>0) then
443	125	line = removeComments(line)
444	125	if ((len_trim(line) > 1000) .and. is_root_PE()) then
445		call MOM_error(WARNING, "MOM_file_parser: Consider using continuation to split up "//&
446	0	"the excessivley long parameter input line "//trim(line))
447		endif
448	125	line = simplifyWhiteSpace(line(:len_trim(line)))
449	125	num_lines = num_lines + 1
450	125	llen = len_trim(line)
451	125	line_len(num_lines) = llen
452	2735	do ch=1,llen ; char_buf(rsc+ch)(1:1) = line(ch:ch) ; enddo
453	125	rsc = rsc + llen
454		endif
455	576	if (openMultiLineComment(line)) inMultiLineComment=.true.
456		endif
457		enddo ! while (.true.)
458		18 continue ! get here when read() reaches EOF
459
460		call assert(num_lines == param_data%num_lines, &
461		'MOM_file_parser: Found different number of valid lines on second ' &
462	2	// 'reading of '//trim(filename))
463		endif ! (is_root_pe())
464
465		! Broadcast the populated arrays line_len and char_buf
466	2	call broadcast(line_len, num_lines, root_pe())
467	2	call broadcast(char_buf(1:total_chars), 1, root_pe())
468
469		! Allocate space to hold contents of the parameter file, including the lines in param_data%fln
470	127	allocate(param_data%fln(num_lines))
471	2	allocate(param_data%line_used(num_lines))
472	127	param_data%line_used(:) = .false.
473		! Populate param_data%fln%line with the keyword lines from parameter file
474	2	rsc = 0
475	127	do n=1,num_lines
476	125	line(1:INPUT_STR_LENGTH) = " "
477	2735	do ch=1,line_len(n) ; line(ch:ch) = char_buf(rsc+ch)(1:1) ; enddo
478	125	param_data%fln(n)%line = trim(line)
479	127	rsc = rsc + line_len(n)
480		enddo
481
482	2	deallocate(char_buf) ; deallocate(line_len)
483
484	4	end subroutine populate_param_data
485
486
487		!> Return True if a /* appears on this line without a closing */
488	1152	function openMultiLineComment(string)
489		character(len=*), intent(in) :: string !< The input string to process
490		logical :: openMultiLineComment
491
492		! Local variables
493		integer :: icom, last
494
495	1152	openMultiLineComment = .false.
496	1152	last = lastNonCommentIndex(string)+1
497	1152	icom = index(string(last:), "/*")
498	1152	if (icom > 0) then
499	0	openMultiLineComment=.true.
500	0	last = last+icom+1
501		endif
502	1152	icom = index(string(last:), "*/") ; if (icom > 0) openMultiLineComment=.false.
503	2304	end function openMultiLineComment
504
505		!> Return True if a */ appears on this line
506	0	function closeMultiLineComment(string)
507		character(len=*), intent(in) :: string !< The input string to process
508		logical :: closeMultiLineComment
509		! True if a */ appears on this line
510	0	closeMultiLineComment = .false.
511	0	if (index(string, "*/")>0) closeMultiLineComment=.true.
512	0	end function closeMultiLineComment
513
514		!> Find position of last character before any comments, As marked by "!", "//", or "/*"
515		!! following F90, C++, or C syntax
516	2554	function lastNonCommentIndex(string)
517		character(len=*), intent(in) :: string !< The input string to process
518		integer :: lastNonCommentIndex
519
520		! Local variables
521		integer :: icom, last
522
523		! This subroutine is the only place where a comment needs to be defined
524	2554	last = len_trim(string)
525	2116	icom = index(string(:last), "!") ; if (icom > 0) last = icom-1 ! F90 style
526	2554	icom = index(string(:last), "//") ; if (icom > 0) last = icom-1 ! C++ style
527	2554	icom = index(string(:last), "/*") ; if (icom > 0) last = icom-1 ! C style
528	2554	lastNonCommentIndex = last
529	5108	end function lastNonCommentIndex
530
531		!> Find position of last non-blank character before any comments
532	1402	function lastNonCommentNonBlank(string)
533		character(len=*), intent(in) :: string !< The input string to process
534		integer :: lastNonCommentNonBlank
535
536	1402	lastNonCommentNonBlank = len_trim(string(:lastNonCommentIndex(string))) ! Ignore remaining trailing blanks
537	1402	end function lastNonCommentNonBlank
538
539		!> Returns a string with tabs replaced by a blank
540	1152	function replaceTabs(string)
541		character(len=*), intent(in) :: string !< The input string to process
542		character(len=len(string)) :: replaceTabs
543
544		integer :: i
545
546	1180800	do i=1, len(string)
547	1180800	if (string(i:i)==achar(9)) then
548	0	replaceTabs(i:i)=" "
549		else
550	1179648	replaceTabs(i:i)=string(i:i)
551		endif
552		enddo
553	1152	end function replaceTabs
554
555		!> Trims comments and leading blanks from string
556	250	function removeComments(string)
557		character(len=*), intent(in) :: string !< The input string to process
558		character(len=len(string)) :: removeComments
559
560		integer :: last
561
562	256250	removeComments=repeat(" ",len(string))
563	250	last = lastNonCommentNonBlank(string)
564	250	removeComments(:last)=adjustl(string(:last)) ! Copy only the non-comment part of string
565	250	end function removeComments
566
567		!> Constructs a string with all repeated white space replaced with single blanks
568		!! and insert white space where it helps delineate tokens (e.g. around =)
569	250	function simplifyWhiteSpace(string)
570		character(len=*), intent(in) :: string !< A string to modify to simplify white space
571		character(len=len(string)+16) :: simplifyWhiteSpace
572
573		! Local variables
574		integer :: i, j
575		logical :: nonBlank = .false., insideString = .false.
576		character(len=1) :: quoteChar=" "
577
578	250	nonBlank = .false. ; insideString = .false. ! NOTE: For some reason this line is needed??
579	250	i=0
580	9470	simplifyWhiteSpace=repeat(" ",len(string)+16)
581	5470	do j=1,len_trim(string)
582	5470	if (insideString) then ! Do not change formatting inside strings
583	288	i=i+1
584	288	simplifyWhiteSpace(i:i)=string(j:j)
585	288	if (string(j:j)==quoteChar) insideString=.false. ! End of string
586		else ! The following is outside of string delimiters
587	4932	if (string(j:j)==" " .or. string(j:j)==achar(9)) then ! Space or tab
588	496	if (nonBlank) then ! Only copy a blank if the preceding character was non-blank
589	250	i=i+1
590	250	simplifyWhiteSpace(i:i)=" " ! Not string(j:j) so that tabs are replace by blanks
591	250	nonBlank=.false.
592		endif
593	4436	elseif (string(j:j)=='"' .or. string(j:j)=="'") then ! Start a sting
594	30	i=i+1
595	30	simplifyWhiteSpace(i:i)=string(j:j)
596	30	insideString=.true.
597	30	quoteChar=string(j:j) ! Keep copy of starting quote
598	30	nonBlank=.true. ! For exit from string
599	4406	elseif (string(j:j)=='=') then
600		! Insert spaces if this character is "=" so that line contains " = "
601	246	if (nonBlank) then
602	0	i=i+1
603	0	simplifyWhiteSpace(i:i)=" "
604		endif
605	246	i=i+2
606	246	simplifyWhiteSpace(i-1:i)=string(j:j)//" "
607	246	nonBlank=.false.
608		else ! All other characters
609	4160	i=i+1
610	4160	simplifyWhiteSpace(i:i)=string(j:j)
611	4160	nonBlank=.true.
612		endif
613		endif ! if (insideString)
614		enddo ! j
615	250	if (insideString) then ! A missing close quote should be flagged
616	0	if (is_root_pe()) call MOM_error(FATAL, &
617		"There is a mismatched quote in the parameter file line: "// &
618	0	trim(string))
619		endif
620	250	end function simplifyWhiteSpace
621
622		!> This subroutine reads the value of an integer model parameter from a parameter file.
623	112	subroutine read_param_int(CS, varname, value, fail_if_missing, set)
624		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
625		!! it is also a structure to parse for run-time parameters
626		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
627		integer, intent(inout) :: value !< The value of the parameter that may be
628		!! read from the parameter file
629		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
630		!! if this variable is not found in the parameter file
631		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
632		!! has been found and successfully set in the input files.
633		! Local variables
634	112	character(len=CS%max_line_len) :: value_string(1)
635		logical :: found, defined
636
637	112	call get_variable_line(CS, varname, found, defined, value_string)
638	112	if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
639	7	read(value_string(1),*,err = 1001) value
640	7	if (present(set)) set = .true.
641		else
642	105	if (present(fail_if_missing)) then ; if (fail_if_missing) then
643	0	if (.not.found) then
644		call MOM_error(FATAL,'read_param_int: Unable to find variable '//trim(varname)// &
645	0	' in any input files.')
646		else
647		call MOM_error(FATAL,'read_param_int: Variable '//trim(varname)// &
648	0	' found but not set in input files.')
649		endif
650		endif ; endif
651	105	if (present(set)) set = .false.
652		endif
653	112	return
654		1001 call MOM_error(FATAL,'read_param_int: read error for integer variable '//trim(varname)// &
655	0	' parsing "'//trim(value_string(1))//'"')
656	112	end subroutine read_param_int
657
658		!> This subroutine reads the values of an array of integer model parameters from a parameter file.
659	2	subroutine read_param_int_array(CS, varname, value, fail_if_missing, set)
660		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
661		!! it is also a structure to parse for run-time parameters
662		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
663		integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be
664		!! read from the parameter file
665		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
666		!! if this variable is not found in the parameter file
667		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
668		!! has been found and successfully set in the input files.
669		! Local variables
670	2	character(len=CS%max_line_len) :: value_string(1)
671		logical :: found, defined
672
673	2	call get_variable_line(CS, varname, found, defined, value_string)
674	2	if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
675	1	if (present(set)) set = .true.
676	1	read(value_string(1),*,end=991,err=1002) value
677	2	991 return
678		else
679	1	if (present(fail_if_missing)) then ; if (fail_if_missing) then
680	0	if (.not.found) then
681		call MOM_error(FATAL,'read_param_int_array: Unable to find variable '//trim(varname)// &
682	0	' in any input files.')
683		else
684		call MOM_error(FATAL,'read_param_int_array: Variable '//trim(varname)// &
685	0	' found but not set in input files.')
686		endif
687		endif ; endif
688	1	if (present(set)) set = .false.
689		endif
690	1	return
691		1002 call MOM_error(FATAL,'read_param_int_array: read error for integer array '//trim(varname)// &
692	0	' parsing "'//trim(value_string(1))//'"')
693	2	end subroutine read_param_int_array
694
695		!> This subroutine reads the value of a real model parameter from a parameter file.
696	389	subroutine read_param_real(CS, varname, value, fail_if_missing, scale, set)
697		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
698		!! it is also a structure to parse for run-time parameters
699		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
700		real, intent(inout) :: value !< The value of the parameter that may be
701		!! read from the parameter file
702		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
703		!! if this variable is not found in the parameter file
704		real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied
705		!! by before it is returned.
706		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
707		!! has been found and successfully set in the input files.
708
709		! Local variables
710	389	character(len=CS%max_line_len) :: value_string(1)
711		logical :: found, defined
712
713	389	call get_variable_line(CS, varname, found, defined, value_string)
714	389	if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
715	81	read(value_string(1),*,err=1003) value
716	81	if (present(scale)) value = scale*value
717	81	if (present(set)) set = .true.
718		else
719	308	if (present(fail_if_missing)) then ; if (fail_if_missing) then
720	0	if (.not.found) then
721		call MOM_error(FATAL,'read_param_real: Unable to find variable '//trim(varname)// &
722	0	' in any input files.')
723		else
724		call MOM_error(FATAL,'read_param_real: Variable '//trim(varname)// &
725	0	' found but not set in input files.')
726		endif
727		endif ; endif
728	308	if (present(set)) set = .false.
729		endif
730	389	return
731		1003 call MOM_error(FATAL,'read_param_real: read error for real variable '//trim(varname)// &
732	0	' parsing "'//trim(value_string(1))//'"')
733	389	end subroutine read_param_real
734
735		!> This subroutine reads the values of an array of real model parameters from a parameter file.
736	9	subroutine read_param_real_array(CS, varname, value, fail_if_missing, scale, set)
737		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
738		!! it is also a structure to parse for run-time parameters
739		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
740		real, dimension(:), intent(inout) :: value !< The value of the parameter that may be
741		!! read from the parameter file
742		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
743		!! if this variable is not found in the parameter file
744		real, optional, intent(in) :: scale !< A scaling factor that the parameter is multiplied
745		!! by before it is returned.
746		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
747		!! has been found and successfully set in the input files.
748
749		! Local variables
750	9	character(len=CS%max_line_len) :: value_string(1)
751		logical :: found, defined
752
753	9	call get_variable_line(CS, varname, found, defined, value_string)
754	9	if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
755	0	read(value_string(1),*,end=991,err=1004) value
756		991 continue
757	0	if (present(scale)) value(:) = scale*value(:)
758	0	if (present(set)) set = .true.
759		else
760	9	if (present(fail_if_missing)) then ; if (fail_if_missing) then
761	0	if (.not.found) then
762		call MOM_error(FATAL,'read_param_real_array: Unable to find variable '//trim(varname)// &
763	0	' in any input files.')
764		else
765		call MOM_error(FATAL,'read_param_real_array: Variable '//trim(varname)// &
766	0	' found but not set in input files.')
767		endif
768		endif ; endif
769	9	if (present(set)) set = .false.
770		endif
771	9	return
772		1004 call MOM_error(FATAL,'read_param_real_array: read error for real array '//trim(varname)// &
773	0	' parsing "'//trim(value_string(1))//'"')
774	9	end subroutine read_param_real_array
775
776		!> This subroutine reads the value of a character string model parameter from a parameter file.
777	73	subroutine read_param_char(CS, varname, value, fail_if_missing, set)
778		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
779		!! it is also a structure to parse for run-time parameters
780		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
781		character(len=*), intent(inout) :: value !< The value of the parameter that may be
782		!! read from the parameter file
783		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
784		!! if this variable is not found in the parameter file
785		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
786		!! has been found and successfully set in the input files.
787		! Local variables
788	73	character(len=CS%max_line_len) :: value_string(1)
789		logical :: found, defined
790
791	73	call get_variable_line(CS, varname, found, defined, value_string)
792	73	if (found) then
793	24	value = trim(strip_quotes(value_string(1)))
794	49	elseif (present(fail_if_missing)) then ; if (fail_if_missing) then
795	0	call MOM_error(FATAL, 'Unable to find variable '//trim(varname)//' in any input files.')
796		endif ; endif
797
798	73	if (present(set)) set = found
799
800	73	end subroutine read_param_char
801
802		!> This subroutine reads the values of an array of character string model parameters from a parameter file.
803	1	subroutine read_param_char_array(CS, varname, value, fail_if_missing, set)
804		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
805		!! it is also a structure to parse for run-time parameters
806		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
807		character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be
808		!! read from the parameter file
809		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
810		!! if this variable is not found in the parameter file
811		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
812		!! has been found and successfully set in the input files.
813
814		! Local variables
815	1	character(len=CS%max_line_len) :: value_string(1), loc_string
816		logical :: found, defined
817		integer :: i, i_out
818
819	1	call get_variable_line(CS, varname, found, defined, value_string)
820	1	if (found) then
821	0	loc_string = trim(value_string(1))
822	0	i = index(loc_string,",")
823	0	i_out = 1
824	0	do while(i>0)
825	0	value(i_out) = trim(strip_quotes(loc_string(:i-1)))
826	0	i_out = i_out+1
827	0	loc_string = trim(adjustl(loc_string(i+1:)))
828	0	i = index(loc_string,",")
829		enddo
830	0	if (len_trim(loc_string)>0) then
831	0	value(i_out) = trim(strip_quotes(adjustl(loc_string)))
832	0	i_out = i_out+1
833		endif
834	0	do i=i_out,SIZE(value) ; value(i) = " " ; enddo
835	1	elseif (present(fail_if_missing)) then ; if (fail_if_missing) then
836	0	call MOM_error(FATAL, 'Unable to find variable '//trim(varname)//' in any input files.')
837		endif ; endif
838
839	1	if (present(set)) set = found
840
841	1	end subroutine read_param_char_array
842
843		!> This subroutine reads the value of a logical model parameter from a parameter file.
844	614	subroutine read_param_logical(CS, varname, value, fail_if_missing, set)
845		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
846		!! it is also a structure to parse for run-time parameters
847		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
848		logical, intent(inout) :: value !< The value of the parameter that may be
849		!! read from the parameter file
850		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
851		!! if this variable is not found in the parameter file
852		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
853		!! has been found and successfully set in the input files.
854
855		! Local variables
856	614	character(len=CS%max_line_len) :: value_string(1)
857		logical :: found, defined
858
859	614	call get_variable_line(CS, varname, found, defined, value_string, paramIsLogical=.true.)
860	614	if (found) then
861	76	value = defined
862	538	elseif (present(fail_if_missing)) then ; if (fail_if_missing) then
863	0	call MOM_error(FATAL, 'Unable to find variable '//trim(varname)//' in any input files.')
864		endif ; endif
865
866	614	if (present(set)) set = found
867
868	614	end subroutine read_param_logical
869
870		!> This subroutine reads the value of a time_type model parameter from a parameter file.
871	4	subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format, set)
872		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
873		!! it is also a structure to parse for run-time parameters
874		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
875		type(time_type), intent(inout) :: value !< The value of the parameter that may be
876		!! read from the parameter file
877		real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for real-number input.
878		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
879		!! if this variable is not found in the parameter file
880		logical, optional, intent(out) :: date_format !< If present, this indicates whether this
881		!! parameter was read in a date format, so that it can
882		!! later be logged in the same format.
883		logical, optional, intent(out) :: set !< If present, this indicates whether this parameter
884		!! has been found and successfully set in the input files.
885
886		! Local variables
887	4	character(len=CS%max_line_len) :: value_string(1)
888		character(len=240) :: err_msg
889		logical :: found, defined
890		real :: real_time, time_unit
891		integer :: vals(7)
892
893	4	if (present(date_format)) date_format = .false.
894
895	4	call get_variable_line(CS, varname, found, defined, value_string)
896	4	if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then
897		! Determine whether value string should be parsed for a real number
898		! or a date, in either a string format or a comma-delimited list of values.
899	2	if ((INDEX(value_string(1),'-') > 0) .and. &
900		(INDEX(value_string(1),'-',back=.true.) > INDEX(value_string(1),'-'))) then
901		! There are two dashes, so this must be a date format.
902	0	value = set_date(value_string(1), err_msg=err_msg)
903	0	if (LEN_TRIM(err_msg) > 0) call MOM_error(FATAL,'read_param_time: '//&
904		trim(err_msg)//' in integer list read error for time-type variable '//&
905	0	trim(varname)// ' parsing "'//trim(value_string(1))//'"')
906	0	if (present(date_format)) date_format = .true.
907	2	elseif (INDEX(value_string(1),',') > 0) then
908		! Initialize vals with an invalid date.
909	0	vals(:) = (/ -999, -999, -999, 0, 0, 0, 0 /)
910	0	read(value_string(1), *, end=995, err=1005) vals
911		995 continue
912	0	if ((vals(1) < 0) .or. (vals(2) < 0) .or. (vals(3) < 0)) &
913		call MOM_error(FATAL,'read_param_time: integer list read error for time-type variable '//&
914	0	trim(varname)// ' parsing "'//trim(value_string(1))//'"')
915		value = set_date(vals(1), vals(2), vals(3), vals(4), vals(5), vals(6), &
916	0	vals(7), err_msg=err_msg)
917	0	if (LEN_TRIM(err_msg) > 0) call MOM_error(FATAL,'read_param_time: '//&
918		trim(err_msg)//' in integer list read error for time-type variable '//&
919	0	trim(varname)// ' parsing "'//trim(value_string(1))//'"')
920	0	if (present(date_format)) date_format = .true.
921		else
922	2	time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit
923	2	read( value_string(1), *) real_time
924	2	value = real_to_time(real_time*time_unit)
925		endif
926	2	if (present(set)) set = .true.
927		else
928	2	if (present(fail_if_missing)) then ; if (fail_if_missing) then
929	0	if (.not.found) then
930	0	call MOM_error(FATAL, 'Unable to find variable '//trim(varname)//' in any input files.')
931		else
932	0	call MOM_error(FATAL, 'Variable '//trim(varname)//' found but not set in input files.')
933		endif
934		endif ; endif
935	2	if (present(set)) set = .false.
936		endif
937	4	return
938
939		1005 call MOM_error(FATAL, 'read_param_time: read error for time-type variable '//&
940	0	trim(varname)// ' parsing "'//trim(value_string(1))//'"')
941	4	end subroutine read_param_time
942
943		!> This function removes single and double quotes from a character string
944	24	function strip_quotes(val_str)
945		character(len=*), intent(in) :: val_str !< The character string to work on
946		character(len=len(val_str)) :: strip_quotes
947		! Local variables
948		integer :: i
949	24	strip_quotes = val_str
950	24	i = index(strip_quotes,ACHAR(34)) ! Double quote
951	72	do while (i>0)
952	48	if (i > 1) then ; strip_quotes = strip_quotes(:i-1)//strip_quotes(i+1:)
953	24	else ; strip_quotes = strip_quotes(2:) ; endif
954	48	i = index(strip_quotes,ACHAR(34)) ! Double quote
955		enddo
956	24	i = index(strip_quotes,ACHAR(39)) ! Single quote
957	24	do while (i>0)
958	0	if (i > 1) then ; strip_quotes = strip_quotes(:i-1)//strip_quotes(i+1:)
959	0	else ; strip_quotes = strip_quotes(2:) ; endif
960	0	i = index(strip_quotes,ACHAR(39)) ! Single quote
961		enddo
962	24	end function strip_quotes
963
964		!> This function returns the maximum number of characters in any input lines after they
965		!! have been combined by any line continuation.
966	2	function max_input_line_length(CS, pf_num) result(max_len)
967		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
968		!! it is also a structure to parse for run-time parameters
969		integer, optional, intent(in) :: pf_num !< If present, only work on a single file in the
970		!! param_file_type, or return 0 if this exceeds the
971		!! number of files in the param_file_type.
972		integer :: max_len !< The maximum number of characters in any input lines after they
973		!! have been combined by any line continuation.
974
975		! Local variables
976		character(len=FILENAME_LENGTH) :: filename
977		character :: last_char
978		integer :: ipf, ipf_s, ipf_e
979		integer :: last, line_len, count, contBufSize
980		logical :: continuedLine
981
982	2	max_len = 0
983	2	ipf_s = 1 ; ipf_e = CS%nfiles
984	2	if (present(pf_num)) then
985	2	if (pf_num > CS%nfiles) return
986	2	ipf_s = pf_num ; ipf_e = pf_num
987		endif
988
989	4	paramfile_loop: do ipf = ipf_s, ipf_e
990	2	filename = CS%filename(ipf)
991	2	contBufSize = 0
992	2	continuedLine = .false.
993
994		! Scan through each line of the file
995	129	do count = 1, CS%param_data(ipf)%num_lines
996		! line = CS%param_data(ipf)%fln(count)%line
997	125	last = len_trim(CS%param_data(ipf)%fln(count)%line)
998	125	last_char = " "
999	125	if (last > 0) last_char = CS%param_data(ipf)%fln(count)%line(last:last)
1000		! Check if line ends in continuation character (either & or \)
1001		! Note achar(92) is a backslash
1002	125	if (last_char == achar(92) .or. last_char == "&") then
1003	0	contBufSize = contBufSize + last - 1
1004	0	continuedLine = .true.
1005	0	if (count==CS%param_data(ipf)%num_lines .and. is_root_pe()) &
1006		call MOM_error(FATAL, "MOM_file_parser : the last line of the file ends in a"// &
1007		" continuation character but there are no more lines to read. "// &
1008		" Line: '"//trim(CS%param_data(ipf)%fln(count)%line(:last))//"'"// &
1009	0	" in file "//trim(filename)//".")
1010	0	cycle ! cycle inorder to append the next line of the file
1011	125	elseif (continuedLine) then
1012		! If we reached this point then this is the end of line continuation
1013	0	line_len = contBufSize + last
1014	0	contBufSize = 0
1015	0	continuedLine = .false.
1016		else ! This is a simple line with no continuation.
1017	125	line_len = last
1018		endif
1019	127	max_len = max(max_len, line_len)
1020		enddo ! CS%param_data(ipf)%num_lines
1021		enddo paramfile_loop
1022
1023	2	end function max_input_line_length
1024
1025		!> This subroutine extracts the contents of lines in the param_file_type that refer to
1026		!! a named parameter. The value_string that is returned must be interpreted in a way
1027		!! that depends on the type of this variable.
1028	1204	subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsLogical)
1029		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1030		!! it is also a structure to parse for run-time parameters
1031		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
1032		logical, intent(out) :: found !< If true, this parameter has been found in CS
1033		logical, intent(out) :: defined !< If true, this parameter is set (or true) in the CS
1034		character(len=*), intent(out) :: value_string(:) !< A string that encodes the new value
1035		logical, optional, intent(in) :: paramIsLogical !< If true, this is a logical parameter
1036		!! that can be simply defined without parsing a value_string.
1037
1038		! Local variables
1039	1204	character(len=CS%max_line_len) :: val_str, lname, origLine
1040	1204	character(len=CS%max_line_len) :: line, continuationBuffer
1041		character(len=240) :: blockName
1042		character(len=FILENAME_LENGTH) :: filename
1043		integer :: is, id, isd, isu, ise, iso, ipf
1044		integer :: last, last1, ival, oval, max_vals, count, contBufSize
1045		character(len=52) :: set
1046		logical :: found_override, found_equals
1047		logical :: found_define, found_undef
1048		logical :: force_cycle, defined_in_line, continuedLine
1049		logical :: variableKindIsLogical, valueIsSame
1050		logical :: inWrongBlock, fullPathParameter
1051		logical, parameter :: requireNamedClose = .false.
1052		integer, parameter :: verbose = 1
1053	1204	set = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
1054	60200	continuationBuffer = repeat(" ", CS%max_line_len)
1055	1204	contBufSize = 0
1056
1057	1204	variableKindIsLogical=.false.
1058	1204	if (present(paramIsLogical)) variableKindIsLogical = paramIsLogical
1059
1060		! Find the first instance (if any) where the named variable is found, and
1061		! return variables indicating whether this variable is defined and the string
1062		! that contains the value of this variable.
1063	1204	found = .false.
1064	1204	oval = 0 ; ival = 0
1065	1204	max_vals = SIZE(value_string)
1066	2408	do is=1,max_vals ; value_string(is) = " " ; enddo
1067
1068	3606	paramfile_loop: do ipf = 1, CS%nfiles
1069	2402	filename = CS%filename(ipf)
1070	2402	continuedLine = .false.
1071	2402	blockName = ''
1072
1073		! Scan through each line of the file
1074	152890	do count = 1, CS%param_data(ipf)%num_lines
1075	150488	line = CS%param_data(ipf)%fln(count)%line
1076	150488	last = len_trim(line)
1077
1078	150488	last1 = max(1,last)
1079		! Check if line ends in continuation character (either & or \)
1080		! Note achar(92) is a backslash
1081	150488	if (line(last1:last1) == achar(92).or.line(last1:last1) == "&") then
1082	0	continuationBuffer(contBufSize+1:contBufSize+len_trim(line))=line(:last-1)
1083	0	contBufSize=contBufSize + len_trim(line)-1
1084	0	continuedLine = .true.
1085	0	if (count==CS%param_data(ipf)%num_lines .and. is_root_pe()) &
1086		call MOM_error(FATAL, "MOM_file_parser : the last line"// &
1087		" of the file ends in a continuation character but"// &
1088		" there are no more lines to read. "// &
1089		" Line: '"//trim(line(:last))//"'"//&
1090	0	" in file "//trim(filename)//".")
1091	0	cycle ! cycle inorder to append the next line of the file
1092	150488	elseif (continuedLine) then
1093		! If we reached this point then this is the end of line continuation
1094	0	continuationBuffer(contBufSize+1:contBufSize+len_trim(line))=line(:last)
1095	0	line = continuationBuffer
1096	0	continuationBuffer=repeat(" ",CS%max_line_len) ! Clear for next use
1097	0	contBufSize = 0
1098	0	continuedLine = .false.
1099	0	last = len_trim(line)
1100		endif
1101
1102	150488	origLine = trim(line) ! Keep original for error messages
1103
1104		! Check for '#override' at start of line
1105	150488	found_override = .false. ; found_define = .false. ; found_undef = .false.
1106	150488	iso = index(line(:last), "#override " )! ; if (is > 0) found_override = .true.
1107	150488	if (iso>1) call MOM_error(FATAL, "MOM_file_parser : #override was found "// &
1108		" but was not the first keyword."// &
1109		" Line: '"//trim(line(:last))//"'"//&
1110	0	" in file "//trim(filename)//".")
1111	150488	if (iso==1) then
1112	2396	found_override = .true.
1113	2396	if (index(line(:last), "#override define ")==1) found_define = .true.
1114	2396	if (index(line(:last), "#override undef ")==1) found_undef = .true.
1115	2396	line = trim(adjustl(line(iso+10:last))) ; last = len_trim(line)
1116		endif
1117
1118		! Newer form of parameter block, block%, %block or block%param or
1119	150488	iso=index(line(:last),'%')
1120	150488	fullPathParameter = .false.
1121	150488	if (iso==1) then ! % is first character means this is a close
1122	1204	if (len_trim(blockName)==0 .and. is_root_pe()) call MOM_error(FATAL, &
1123		'get_variable_line: An extra close block was encountered. Line="'// &
1124	0	trim(line(:last))//'"' )
1125	1204	if (last>1 .and. trim(blockName)/=trim(line(2:last)) .and. is_root_pe()) &
1126		call MOM_error(FATAL, 'get_variable_line: A named close for a parameter'// &
1127	0	' block did not match the open block. Line="'//trim(line(:last))//'"' )
1128		if (last==1 .and. requireNamedClose) & ! line = '%' is a generic (unnamed) close
1129		call MOM_error(FATAL, 'get_variable_line: A named close for a parameter'// &
1130		' block is required but found "%". Block="'//trim(blockName)//'"' )
1131	1204	blockName = popBlockLevel(blockName)
1132	1204	call flag_line_as_read(CS%param_data(ipf)%line_used,count)
1133	149284	elseif (iso==last) then ! This is a new block if % is last character
1134	1204	blockName = pushBlockLevel(blockName, line(:iso-1))
1135	1204	call flag_line_as_read(CS%param_data(ipf)%line_used,count)
1136		else ! This is of the form block%parameter = ... (full path parameter)
1137	148080	iso=index(line(:last),'%',.true.)
1138		! Check that the parameter block names on the line matches the state set by the caller
1139	148080	if (iso>0 .and. trim(CS%blockName%name)==trim(line(:iso-1))) then
1140	0	fullPathParameter = .true.
1141	0	line = trim(line(iso+1:last)) ! Strip away the block name for subsequent processing
1142	0	last = len_trim(line)
1143		endif
1144		endif
1145
1146		! We should only interpret this line if this block is the active block
1147	150488	inWrongBlock = .false.
1148	150488	if (len_trim(blockName)>0) then ! In a namelist block in file
1149	7224	if (trim(CS%blockName%name)/=trim(blockName)) inWrongBlock = .true. ! Not in the required block
1150		endif
1151	150488	if (len_trim(CS%blockName%name)>0) then ! In a namelist block in the model
1152	2250	if (trim(CS%blockName%name)/=trim(blockName)) inWrongBlock = .true. ! Not in the required block
1153		endif
1154
1155	150488	if (inWrongBlock .and. .not. fullPathParameter) then
1156	9258	if (index(" "//line(:last+1), " "//trim(varname)//" ")>0) &
1157		call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// &
1158	0	' found outside of block '//trim(CS%blockName%name)//'%. Ignoring.')
1159	9258	cycle
1160		endif
1161
1162		! Determine whether this line mentions the named parameter or not
1163	141230	if (index(" "//line(:last)//" ", " "//trim(varname)//" ") == 0) cycle
1164
1165		! Detect keywords
1166	192	found_equals = .false.
1167	192	isd = index(line(:last), "define" )! ; if (isd > 0) found_define = .true.
1168	192	isu = index(line(:last), "undef" )! ; if (isu > 0) found_undef = .true.
1169	192	ise = index(line(:last), " = " ) ; if (ise > 1) found_equals = .true.
1170	192	if (index(line(:last), "#define ")==1) found_define = .true.
1171	192	if (index(line(:last), "#undef ")==1) found_undef = .true.
1172
1173		! Check for missing, mutually exclusive or incomplete keywords
1174	192	if (.not. (found_define .or. found_undef .or. found_equals)) then
1175	0	if (found_override) then
1176		call MOM_error(FATAL, "MOM_file_parser : override was found " // &
1177		" without a define or undef." // &
1178		" Line: '" // trim(line(:last)) // "'" // &
1179	0	" in file " // trim(filename) // ".")
1180		else
1181		call MOM_error(FATAL, "MOM_file_parser : the parameter name '" // &
1182		trim(varname) // "' was found without define or undef." // &
1183		" Line: '" // trim(line(:last)) // "'" // &
1184	0	" in file " // trim(filename) // ".")
1185		endif
1186		endif
1187
1188	192	if (found_equals .and. (found_define .or. found_undef)) &
1189		call MOM_error(FATAL, &
1190		"MOM_file_parser : Both 'a=b' and 'undef/define' syntax occur."// &
1191		" Line: '"//trim(line(:last))//"'"//&
1192	0	" in file "//trim(filename)//".")
1193
1194		! Interpret the line and collect values, if any
1195		! NOTE: At least one of these must be true
1196	192	if (found_define) then
1197		! Move starting pointer to first letter of defined name.
1198	0	is = isd + 5 + scan(line(isd+6:last), set)
1199
1200	0	id = scan(line(is:last), ' ') ! Find space between name and value
1201	0	if ( id == 0 ) then
1202		! There is no space so the name is simply being defined.
1203	0	lname = trim(line(is:last))
1204	0	if (trim(lname) /= trim(varname)) cycle
1205	0	val_str = " "
1206		else
1207		! There is a string or number after the name.
1208	0	lname = trim(line(is:is+id-1))
1209	0	if (trim(lname) /= trim(varname)) cycle
1210	0	val_str = trim(adjustl(line(is+id:last)))
1211		endif
1212	0	found = .true. ; defined_in_line = .true.
1213	192	elseif (found_undef) then
1214		! Move starting pointer to first letter of undefined name.
1215	0	is = isu + 4 + scan(line(isu+5:last), set)
1216
1217	0	id = scan(line(is:last), ' ') ! Find the first space after the name.
1218	0	if (id > 0) last = is + id - 1
1219	0	lname = trim(line(is:last))
1220	0	if (trim(lname) /= trim(varname)) cycle
1221	0	val_str = " "
1222	0	found = .true. ; defined_in_line = .false.
1223	192	elseif (found_equals) then
1224		! Move starting pointer to first letter of defined name.
1225	192	is = scan(line(1:ise), set)
1226	192	lname = trim(line(is:ise-1))
1227	192	if (trim(lname) /= trim(varname)) cycle
1228	192	val_str = trim(adjustl(line(ise+3:last)))
1229	192	if (variableKindIsLogical) then ! Special handling for logicals
1230	76	read(val_str(:len_trim(val_str)),*) defined_in_line
1231		else
1232	116	defined_in_line = .true.
1233		endif
1234	192	found = .true.
1235		endif
1236
1237		! This line has now been used.
1238	192	call flag_line_as_read(CS%param_data(ipf)%line_used,count)
1239
1240		! Detect inconsistencies
1241	192	force_cycle = .false.
1242	192	valueIsSame = (trim(val_str) == trim(value_string(max_vals)))
1243	192	if (found_override .and. (oval >= max_vals)) then
1244	0	if (is_root_pe()) then
1245	0	if ((defined_in_line .neqv. defined) .or. .not. valueIsSame) then
1246		call MOM_error(FATAL,"MOM_file_parser : "//trim(varname)// &
1247		" found with multiple inconsistent overrides."// &
1248		" Line A: '"//trim(value_string(max_vals))//"'"//&
1249		" Line B: '"//trim(line(:last))//"'"//&
1250	0	" in file "//trim(filename)//" caused the model failure.")
1251		else
1252		call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// &
1253		" over-ridden more times than is permitted."// &
1254		" Line: '"//trim(line(:last))//"'"//&
1255	0	" in file "//trim(filename)//" is being ignored.")
1256		endif
1257		endif
1258	0	force_cycle = .true.
1259		endif
1260	192	if (.not.found_override .and. (oval > 0)) then
1261	0	if (is_root_pe()) &
1262		call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// &
1263		" has already been over-ridden."// &
1264		" Line: '"//trim(line(:last))//"'"//&
1265	0	" in file "//trim(filename)//" is being ignored.")
1266	0	force_cycle = .true.
1267		endif
1268	192	if (.not.found_override .and. (ival >= max_vals)) then
1269	0	if (is_root_pe()) then
1270	0	if ((defined_in_line .neqv. defined) .or. .not. valueIsSame) then
1271		call MOM_error(FATAL,"MOM_file_parser : "//trim(varname)// &
1272		" found with multiple inconsistent definitions."// &
1273		" Line A: '"//trim(value_string(max_vals))//"'"//&
1274		" Line B: '"//trim(line(:last))//"'"//&
1275	0	" in file "//trim(filename)//" caused the model failure.")
1276		else
1277		call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// &
1278		" occurs more times than is permitted."// &
1279		" Line: '"//trim(line(:last))//"'"//&
1280	0	" in file "//trim(filename)//" is being ignored.")
1281		endif
1282		endif
1283	0	force_cycle = .true.
1284		endif
1285	192	if (force_cycle) cycle
1286
1287		! Store new values
1288	2594	if (found_override) then
1289	2	oval = oval + 1
1290	2	value_string(oval) = trim(val_str)
1291	2	defined = defined_in_line
1292	2	if (verbose > 0 .and. ival > 0 .and. is_root_pe() .and. &
1293		.not. overrideWarningHasBeenIssued(CS%chain, trim(varname)) ) &
1294		call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// &
1295		" over-ridden. Line: '"//trim(line(:last))//"'"//&
1296	1	" in file "//trim(filename)//".")
1297		else ! (.not. found_overide)
1298	190	ival = ival + 1
1299	190	value_string(ival) = trim(val_str)
1300	190	defined = defined_in_line
1301
1302	190	if (verbose > 1 .and. is_root_pe()) &
1303		call MOM_error(WARNING,"MOM_file_parser : "//trim(varname)// &
1304		" set. Line: '"//trim(line(:last))//"'"//&
1305		" in file "//trim(filename)//".")
1306		endif
1307
1308		enddo ! CS%param_data(ipf)%num_lines
1309
1310	2402	if (len_trim(blockName)>0 .and. is_root_pe()) call MOM_error(FATAL, &
1311		'A namelist/parameter block was not closed. Last open block appears '// &
1312	1204	'to be "'//trim(blockName)//'".')
1313
1314		enddo paramfile_loop
1315
1316	1204	end subroutine get_variable_line
1317
1318		!> Record that a line has been used to set a parameter
1319	2600	subroutine flag_line_as_read(line_used, count)
1320		logical, dimension(:), pointer :: line_used !< A structure indicating which lines have been read
1321		integer, intent(in) :: count !< The parameter on this line number has been read
1322	2600	line_used(count) = .true.
1323	2600	end subroutine flag_line_as_read
1324
1325		!> Returns true if an override warning has been issued for the variable varName
1326	2	function overrideWarningHasBeenIssued(chain, varName)
1327		type(link_parameter), pointer :: chain !< The linked list of variables that have already had
1328		!! override warnings issued
1329		character(len=*), intent(in) :: varName !< The name of the variable being queried for warnings
1330		logical :: overrideWarningHasBeenIssued
1331		! Local variables
1332		type(link_parameter), pointer :: newLink => NULL(), this => NULL()
1333
1334	2	overrideWarningHasBeenIssued = .false.
1335	2	this => chain
1336	3	do while( associated(this) )
1337	1	if (trim(varName) == trim(this%name)) then
1338	0	overrideWarningHasBeenIssued = .true.
1339	0	return
1340		endif
1341	1	this => this%next
1342		enddo
1343	2	allocate(newLink)
1344	2	newLink%name = trim(varName)
1345	2	newLink%hasIssuedOverrideWarning = .true.
1346	2	newLink%next => chain
1347	2	chain => newLink
1348	4	end function overrideWarningHasBeenIssued
1349
1350		! The following subroutines write out to a log file.
1351
1352		!> Log the version of a module to a log file and/or stdout, and/or to the
1353		!! parameter documentation file.
1354	65	subroutine log_version_cs(CS, modulename, version, desc, log_to_all, all_default, layout, debugging)
1355		type(param_file_type), intent(in) :: CS !< File parser type
1356		character(len=*), intent(in) :: modulename !< Name of calling module
1357		character(len=*), intent(in) :: version !< Version string of module
1358		character(len=*), optional, intent(in) :: desc !< Module description
1359		logical, optional, intent(in) :: log_to_all !< If present and true, log this parameter to the
1360		!! ..._doc.all files, even if this module also has layout
1361		!! or debugging parameters.
1362		logical, optional, intent(in) :: all_default !< If true, all parameters take their default values.
1363		logical, optional, intent(in) :: layout !< If present and true, this module has layout parameters.
1364		logical, optional, intent(in) :: debugging !< If present and true, this module has debugging parameters.
1365		! Local variables
1366		character(len=240) :: mesg
1367
1368	65	mesg = trim(modulename)//": "//trim(version)
1369	65	if (is_root_pe()) then
1370	65	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1371	65	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1372		endif
1373
1374	65	if (present(desc)) call doc_module(CS%doc, modulename, desc, log_to_all, all_default, layout, debugging)
1375
1376	65	end subroutine log_version_cs
1377
1378		!> Log the version of a module to a log file and/or stdout.
1379	2	subroutine log_version_plain(modulename, version)
1380		character(len=*), intent(in) :: modulename !< Name of calling module
1381		character(len=*), intent(in) :: version !< Version string of module
1382		! Local variables
1383		character(len=240) :: mesg
1384
1385	2	mesg = trim(modulename)//": "//trim(version)
1386	2	if (is_root_pe()) then
1387	2	write(stdlog(),'(a)') trim(mesg)
1388		endif
1389
1390	2	end subroutine log_version_plain
1391
1392		!> Log the name and value of an integer model parameter in documentation files.
1393	87	subroutine log_param_int(CS, modulename, varname, value, desc, units, &
1394		default, layoutParam, debuggingParam, like_default)
1395		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1396		!! it is also a structure to parse for run-time parameters
1397		character(len=*), intent(in) :: modulename !< The name of the module using this parameter
1398		character(len=*), intent(in) :: varname !< The name of the parameter to log
1399		integer, intent(in) :: value !< The value of the parameter to log
1400		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1401		!! present, this parameter is not written to a doc file
1402		character(len=*), optional, intent(in) :: units !< The units of this parameter
1403		integer, optional, intent(in) :: default !< The default value of the parameter
1404		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1405		!! logged in the layout parameter file
1406		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1407		!! logged in the debugging parameter file
1408		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1409		!! though it has the default value, even if there is no default.
1410
1411		character(len=240) :: mesg, myunits
1412
1413	87	write(mesg, '(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(value))
1414	87	if (is_root_pe()) then
1415	87	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1416	87	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1417		endif
1418
1419	87	myunits = " " ; if (present(units)) write(myunits(1:240),'(A)') trim(units)
1420	87	if (present(desc)) &
1421		call doc_param(CS%doc, varname, desc, myunits, value, default, &
1422	82	layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default)
1423
1424	87	end subroutine log_param_int
1425
1426		!> Log the name and values of an array of integer model parameter in documentation files.
1427	2	subroutine log_param_int_array(CS, modulename, varname, value, desc, &
1428	2	units, default, defaults, layoutParam, debuggingParam, like_default)
1429		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1430		!! it is also a structure to parse for run-time parameters
1431		character(len=*), intent(in) :: modulename !< The name of the module using this parameter
1432		character(len=*), intent(in) :: varname !< The name of the parameter to log
1433		integer, dimension(:), intent(in) :: value !< The value of the parameter to log
1434		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1435		!! present, this parameter is not written to a doc file
1436		character(len=*), optional, intent(in) :: units !< The units of this parameter
1437		integer, optional, intent(in) :: default !< The uniform default value of this parameter
1438		integer, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter
1439		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1440		!! logged in the layout parameter file
1441		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1442		!! logged in the debugging parameter file
1443		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1444		!! though it has the default value, even if there is no default.
1445
1446	2	character(len=CS%max_line_len+120) :: mesg
1447		character(len=240) :: myunits
1448
1449	2	write(mesg, '(" ",a," ",a,": ",A)') trim(modulename), trim(varname), trim(left_ints(value))
1450	2	if (is_root_pe()) then
1451	2	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1452	2	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1453		endif
1454
1455	2	myunits = " " ; if (present(units)) write(myunits(1:240),'(A)') trim(units)
1456	2	if (present(desc)) &
1457		call doc_param(CS%doc, varname, desc, myunits, value, default, defaults, &
1458	2	layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default)
1459
1460	2	end subroutine log_param_int_array
1461
1462		!> Log the name and value of a real model parameter in documentation files.
1463	295	subroutine log_param_real(CS, modulename, varname, value, desc, units, &
1464		default, debuggingParam, like_default, unscale)
1465		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1466		!! it is also a structure to parse for run-time parameters
1467		character(len=*), intent(in) :: modulename !< The name of the calling module
1468		character(len=*), intent(in) :: varname !< The name of the parameter to log
1469		real, intent(in) :: value !< The value of the parameter to log
1470		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1471		!! present, this parameter is not written to a doc file
1472		character(len=*), intent(in) :: units !< The units of this parameter
1473		real, optional, intent(in) :: default !< The default value of the parameter
1474		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1475		!! logged in the debugging parameter file
1476		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1477		!! though it has the default value, even if there is no default.
1478		real, optional, intent(in) :: unscale !< A reciprocal scaling factor that the parameter is
1479		!! multiplied by before it is logged
1480
1481		real :: log_val ! The parameter value that is written out
1482		character(len=240) :: mesg, myunits
1483
1484	5	log_val = value ; if (present(unscale)) log_val = unscale * value
1485
1486		write(mesg, '(" ",a," ",a,": ",a)') &
1487	295	trim(modulename), trim(varname), trim(left_real(log_val))
1488	295	if (is_root_pe()) then
1489	295	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1490	295	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1491		endif
1492
1493	295	write(myunits(1:240),'(A)') trim(units)
1494	295	if (present(desc)) &
1495		call doc_param(CS%doc, varname, desc, myunits, log_val, default, &
1496	282	debuggingParam=debuggingParam, like_default=like_default)
1497
1498	295	end subroutine log_param_real
1499
1500		!> Log the name and values of an array of real model parameter in documentation files.
1501	3	subroutine log_param_real_array(CS, modulename, varname, value, desc, &
1502	3	units, default, defaults, debuggingParam, like_default, unscale)
1503		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1504		!! it is also a structure to parse for run-time parameters
1505		character(len=*), intent(in) :: modulename !< The name of the calling module
1506		character(len=*), intent(in) :: varname !< The name of the parameter to log
1507		real, dimension(:), intent(in) :: value !< The value of the parameter to log
1508		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1509		!! present, this parameter is not written to a doc file
1510		character(len=*), intent(in) :: units !< The units of this parameter
1511		real, optional, intent(in) :: default !< A uniform default value of the parameter
1512		real, optional, intent(in) :: defaults(:) !< The element-wise defaults of the parameter
1513		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1514		!! logged in the debugging parameter file
1515		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1516		!! though it has the default value, even if there is no default.
1517		real, optional, intent(in) :: unscale !< A reciprocal scaling factor that the parameter is
1518		!! multiplied by before it is logged
1519
1520	6	real, dimension(size(value)) :: log_val ! The array of parameter values that is written out
1521	3	character(len=:), allocatable :: mesg
1522		character(len=240) :: myunits
1523
1524	84	log_val(:) = value(:) ; if (present(unscale)) log_val(:) = unscale * value(:)
1525
1526		!write(mesg, '(" ",a," ",a,": ",ES19.12,99(",",ES19.12))') &
1527		!write(mesg, '(" ",a," ",a,": ",G,99(",",G))') &
1528		! trim(modulename), trim(varname), value
1529	3	mesg = " " // trim(modulename) // " " // trim(varname) // ": " // trim(left_reals(log_val))
1530	3	if (is_root_pe()) then
1531	3	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1532	3	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1533		endif
1534
1535	3	write(myunits(1:240),'(A)') trim(units)
1536	3	if (present(desc)) &
1537		call doc_param(CS%doc, varname, desc, myunits, log_val, default, defaults, &
1538	3	debuggingParam=debuggingParam, like_default=like_default)
1539
1540	6	end subroutine log_param_real_array
1541
1542		!> Log the name and value of a logical model parameter in documentation files.
1543	395	subroutine log_param_logical(CS, modulename, varname, value, desc, &
1544		units, default, layoutParam, debuggingParam, like_default)
1545		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1546		!! it is also a structure to parse for run-time parameters
1547		character(len=*), intent(in) :: modulename !< The name of the calling module
1548		character(len=*), intent(in) :: varname !< The name of the parameter to log
1549		logical, intent(in) :: value !< The value of the parameter to log
1550		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1551		!! present, this parameter is not written to a doc file
1552		character(len=*), optional, intent(in) :: units !< The units of this parameter
1553		logical, optional, intent(in) :: default !< The default value of the parameter
1554		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1555		!! logged in the layout parameter file
1556		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1557		!! logged in the debugging parameter file
1558		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1559		!! though it has the default value, even if there is no default.
1560
1561		character(len=240) :: mesg, myunits
1562
1563	395	if (value) then
1564	117	write(mesg, '(" ",a," ",a,": True")') trim(modulename), trim(varname)
1565		else
1566	278	write(mesg, '(" ",a," ",a,": False")') trim(modulename), trim(varname)
1567		endif
1568	395	if (is_root_pe()) then
1569	395	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1570	395	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1571		endif
1572
1573	395	myunits = "Boolean" ; if (present(units)) write(myunits(1:240),'(A)') trim(units)
1574	395	if (present(desc)) &
1575		call doc_param(CS%doc, varname, desc, myunits, value, default, &
1576	383	layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default)
1577
1578	395	end subroutine log_param_logical
1579
1580		!> Log the name and value of a character string model parameter in documentation files.
1581	53	subroutine log_param_char(CS, modulename, varname, value, desc, units, &
1582		default, layoutParam, debuggingParam, like_default)
1583		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1584		!! it is also a structure to parse for run-time parameters
1585		character(len=*), intent(in) :: modulename !< The name of the calling module
1586		character(len=*), intent(in) :: varname !< The name of the parameter to log
1587		character(len=*), intent(in) :: value !< The value of the parameter to log
1588		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1589		!! present, this parameter is not written to a doc file
1590		character(len=*), optional, intent(in) :: units !< The units of this parameter
1591		character(len=*), optional, intent(in) :: default !< The default value of the parameter
1592		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1593		!! logged in the layout parameter file
1594		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1595		!! logged in the debugging parameter file
1596		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1597		!! though it has the default value, even if there is no default.
1598
1599	53	character(len=:), allocatable :: mesg
1600		character(len=240) :: myunits
1601
1602	53	mesg = " " // trim(modulename) // " " // trim(varname) // ": " // trim(value)
1603	53	if (is_root_pe()) then
1604	53	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1605	53	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1606		endif
1607
1608	53	myunits = " " ; if (present(units)) write(myunits(1:240),'(A)') trim(units)
1609	53	if (present(desc)) &
1610		call doc_param(CS%doc, varname, desc, myunits, value, default, &
1611	44	layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default)
1612
1613	106	end subroutine log_param_char
1614
1615		!> This subroutine writes the value of a time-type parameter to a log file,
1616		!! along with its name and the module it came from.
1617	8	subroutine log_param_time(CS, modulename, varname, value, desc, units, &
1618		default, timeunit, layoutParam, debuggingParam, log_date, like_default)
1619		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1620		!! it is also a structure to parse for run-time parameters
1621		character(len=*), intent(in) :: modulename !< The name of the calling module
1622		character(len=*), intent(in) :: varname !< The name of the parameter to log
1623		type(time_type), intent(in) :: value !< The value of the parameter to log
1624		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1625		!! present, this parameter is not written to a doc file
1626		character(len=*), optional, intent(in) :: units !< The units of this parameter
1627		type(time_type), optional, intent(in) :: default !< The default value of the parameter
1628		real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for
1629		!! real-number output.
1630		logical, optional, intent(in) :: log_date !< If true, log the time_type in date format.
1631		!! If missing the default is false.
1632		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1633		!! logged in the layout parameter file
1634		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1635		!! logged in the debugging parameter file
1636		logical, optional, intent(in) :: like_default !< If present and true, log this parameter as
1637		!! though it has the default value, even if there is no default.
1638
1639		! Local variables
1640		real :: real_time, real_default
1641		logical :: use_timeunit, date_format
1642		character(len=240) :: mesg, myunits
1643		character(len=80) :: date_string, default_string
1644		integer :: days, secs, ticks
1645
1646	4	use_timeunit = .false.
1647	4	date_format = .false. ; if (present(log_date)) date_format = log_date
1648
1649	4	call get_time(value, secs, days, ticks)
1650
1651	4	if (ticks == 0) then
1652	4	write(mesg, '(" ",a," ",a," (Time): ",i0,":",i0)') trim(modulename), &
1653	8	trim(varname), days, secs
1654		else
1655	0	write(mesg, '(" ",a," ",a," (Time): ",i0,":",i0,":",i0)') trim(modulename), &
1656	0	trim(varname), days, secs, ticks
1657		endif
1658	4	if (is_root_pe()) then
1659	4	if (CS%log_open) write(CS%stdlog,'(a)') trim(mesg)
1660	4	if (CS%log_to_stdout) write(CS%stdout,'(a)') trim(mesg)
1661		endif
1662
1663	4	if (present(desc)) then
1664	4	if (present(timeunit)) use_timeunit = (timeunit > 0.0)
1665	4	if (date_format) then
1666	0	myunits='[date]'
1667
1668	0	date_string = convert_date_to_string(value)
1669	0	if (present(default)) then
1670	0	default_string = convert_date_to_string(default)
1671		call doc_param(CS%doc, varname, desc, myunits, date_string, &
1672		default=default_string, layoutParam=layoutParam, &
1673	0	debuggingParam=debuggingParam, like_default=like_default)
1674		else
1675		call doc_param(CS%doc, varname, desc, myunits, date_string, &
1676	0	layoutParam=layoutParam, debuggingParam=debuggingParam, like_default=like_default)
1677		endif
1678	4	elseif (use_timeunit) then
1679	4	if (present(units)) then
1680	0	write(myunits(1:240),'(A)') trim(units)
1681		else
1682	4	if (abs(timeunit-1.0) < 0.01) then ; myunits = "seconds"
1683	4	elseif (abs(timeunit-3600.0) < 1.0) then ; myunits = "hours"
1684	4	elseif (abs(timeunit-86400.0) < 1.0) then ; myunits = "days"
1685	0	elseif (abs(timeunit-3.1e7) < 1.0e6) then ; myunits = "years"
1686	0	else ; write(myunits,'(es8.2," sec")') timeunit ; endif
1687		endif
1688	4	real_time = (86400.0/timeunit)*days + secs/timeunit
1689	4	if (ticks > 0) real_time = real_time + &
1690	0	real(ticks) / (timeunit*get_ticks_per_second())
1691	4	if (present(default)) then
1692	3	call get_time(default, secs, days, ticks)
1693	3	real_default = (86400.0/timeunit)*days + secs/timeunit
1694	3	if (ticks > 0) real_default = real_default + &
1695	0	real(ticks) / (timeunit*get_ticks_per_second())
1696	3	call doc_param(CS%doc, varname, desc, myunits, real_time, real_default, like_default=like_default)
1697		else
1698	1	call doc_param(CS%doc, varname, desc, myunits, real_time, like_default=like_default)
1699		endif
1700		else
1701	0	call doc_param(CS%doc, varname, desc, value, default, units=units, like_default=like_default)
1702		endif
1703		endif
1704
1705	4	end subroutine log_param_time
1706
1707		!> This function converts a date into a string, valid with ticks and for dates up to year 99,999,999
1708	0	function convert_date_to_string(date) result(date_string)
1709		type(time_type), intent(in) :: date !< The date to be translated into a string.
1710		character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss
1711
1712		! Local variables
1713		character(len=40) :: sub_string
1714		real :: real_secs
1715		integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec
1716
1717	0	call get_date(date, yrs, mons, days, hours, mins, secs, ticks)
1718	0	write (date_string, '(i8.4)') yrs
1719		write (sub_string, '("-", i2.2, "-", I2.2, " ", i2.2, ":", i2.2, ":")') &
1720	0	mons, days, hours, mins
1721	0	date_string = trim(adjustl(date_string)) // trim(sub_string)
1722	0	if (ticks > 0) then
1723	0	ticks_per_sec = get_ticks_per_second()
1724	0	real_secs = secs + ticks/ticks_per_sec
1725	0	if (ticks_per_sec <= 100) then
1726	0	write (sub_string, '(F7.3)') real_secs
1727		else
1728	0	write (sub_string, '(F10.6)') real_secs
1729		endif
1730		else
1731	0	write (sub_string, '(i2.2)') secs
1732		endif
1733	0	date_string = trim(date_string) // trim(adjustl(sub_string))
1734
1735	0	end function convert_date_to_string
1736
1737		!> This subroutine reads the value of an integer model parameter from a parameter file
1738		!! and logs it in documentation files.
1739	106	subroutine get_param_int(CS, modulename, varname, value, desc, units, &
1740		default, fail_if_missing, do_not_read, do_not_log, &
1741		layoutParam, debuggingParam, old_name)
1742		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1743		!! it is also a structure to parse for run-time parameters
1744		character(len=*), intent(in) :: modulename !< The name of the calling module
1745		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
1746		integer, intent(inout) :: value !< The value of the parameter that may be
1747		!! read from the parameter file and logged
1748		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1749		!! present, this parameter is not written to a doc file
1750		character(len=*), optional, intent(in) :: units !< The units of this parameter
1751		integer, optional, intent(in) :: default !< The default value of the parameter
1752		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
1753		!! if this variable is not found in the parameter file
1754		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
1755		!! value for this parameter, although it might be logged.
1756		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
1757		!! parameter to the documentation files
1758		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1759		!! logged in the layout parameter file
1760		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1761		!! logged in the debugging parameter file
1762		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
1763		!! to read. Errors or warnings are issued if the old name
1764		!! is being used.
1765
1766		! Local variables
1767		logical :: do_read, do_log
1768		logical :: new_name_used, old_name_used, same_value
1769		integer :: new_name_value ! The value that is set when the standard name is used.
1770
1771	0	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
1772	106	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
1773
1774	106	if (do_read) then
1775	106	if (present(default)) value = default
1776
1777	106	old_name_used = .false.
1778	106	if (present(old_name)) then
1779	0	new_name_value = value
1780	0	call read_param_int(CS, old_name, value, set=old_name_used)
1781	0	if (old_name_used) then
1782	0	call read_param_int(CS, varname, new_name_value, set=new_name_used)
1783
1784		! Issue appropriate warnings or error messages.
1785	0	same_value = (value == new_name_value)
1786	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
1787		endif
1788		endif
1789
1790	106	if (.not.old_name_used) then ! Old name is either not present or not set.
1791	106	call read_param_int(CS, varname, value, fail_if_missing)
1792		endif
1793		endif
1794
1795	106	if (do_log) then
1796		call log_param_int(CS, modulename, varname, value, desc, units, &
1797	83	default, layoutParam, debuggingParam)
1798		endif
1799
1800	106	end subroutine get_param_int
1801
1802		!> This subroutine reads the values of an array of integer model parameters from a parameter file
1803		!! and logs them in documentation files.
1804	2	subroutine get_param_int_array(CS, modulename, varname, value, desc, units, &
1805	2	default, defaults, fail_if_missing, do_not_read, do_not_log, &
1806		layoutParam, debuggingParam, old_name)
1807		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1808		!! it is also a structure to parse for run-time parameters
1809		character(len=*), intent(in) :: modulename !< The name of the calling module
1810		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
1811		integer, dimension(:), intent(inout) :: value !< The value of the parameter that may be reset
1812		!! from the parameter file
1813		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1814		!! present, this parameter is not written to a doc file
1815		character(len=*), optional, intent(in) :: units !< The units of this parameter
1816		integer, optional, intent(in) :: default !< The uniform default value of this parameter
1817		integer, optional, intent(in) :: defaults(:) !< The element-wise default values of this parameter
1818		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
1819		!! if this variable is not found in the parameter file
1820		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
1821		!! value for this parameter, although it might be logged.
1822		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
1823		!! parameter to the documentation files
1824		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
1825		!! logged in the layout parameter file
1826		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1827		!! logged in the debugging parameter file
1828		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
1829		!! to read. Errors or warnings are issued if the old name
1830		!! is being used.
1831
1832		! Local variables
1833		logical :: do_read, do_log
1834		logical :: new_name_used, old_name_used, same_value
1835	4	integer :: new_name_value(size(value)) ! The values that are set when the old name is used.
1836		integer :: m
1837
1838	2	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
1839	2	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
1840
1841	2	if (present(defaults)) then
1842	2	if (present(default)) call MOM_error(FATAL, &
1843	0	"get_param_int_array: Only one of default and defaults can be specified at a time.")
1844	2	if (size(defaults) /= size(value)) call MOM_error(FATAL, &
1845	0	"get_param_int_array: The size of defaults and value are not the same.")
1846		endif
1847
1848	2	if (do_read) then
1849	2	if (present(default)) value(:) = default
1850	6	if (present(defaults)) value(:) = defaults(:)
1851
1852	2	old_name_used = .false.
1853	2	if (present(old_name)) then
1854	0	new_name_value(:) = value(:)
1855	0	call read_param_int_array(CS, old_name, value, set=old_name_used)
1856	0	if (old_name_used) then
1857	0	call read_param_int_array(CS, varname, new_name_value, set=new_name_used)
1858
1859		! Issue appropriate warnings or error messages.
1860	0	same_value = .true.
1861	0	do m=1,size(value) ; if (value(m) /= new_name_value(m)) same_value = .false. ; enddo
1862	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
1863		endif
1864		endif
1865
1866	2	if (.not.old_name_used) then ! Old name is either not present or not set.
1867	2	call read_param_int_array(CS, varname, value, fail_if_missing)
1868		endif
1869		endif
1870
1871	2	if (do_log) then
1872		call log_param_int_array(CS, modulename, varname, value, desc, units, &
1873	1	default, defaults, layoutParam, debuggingParam)
1874		endif
1875
1876	2	end subroutine get_param_int_array
1877
1878		!> This subroutine reads the value of a real model parameter from a parameter file
1879		!! and logs it in documentation files.
1880	369	subroutine get_param_real(CS, modulename, varname, value, desc, units, &
1881		default, fail_if_missing, do_not_read, do_not_log, &
1882		debuggingParam, scale, unscaled, old_name)
1883		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1884		!! it is also a structure to parse for run-time parameters
1885		character(len=*), intent(in) :: modulename !< The name of the calling module
1886		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
1887		real, intent(inout) :: value !< The value of the parameter that may be
1888		!! read from the parameter file and logged
1889		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1890		!! present, this parameter is not written to a doc file
1891		character(len=*), intent(in) :: units !< The units of this parameter
1892		real, optional, intent(in) :: default !< The default value of the parameter
1893		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
1894		!! if this variable is not found in the parameter file
1895		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
1896		!! value for this parameter, although it might be logged.
1897		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
1898		!! parameter to the documentation files
1899		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1900		!! logged in the debugging parameter file
1901		real, optional, intent(in) :: scale !< A scaling factor that the parameter is
1902		!! multiplied by before it is returned.
1903		real, optional, intent(out) :: unscaled !< The value of the parameter that would be
1904		!! returned without any multiplication by a scaling factor.
1905		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
1906		!! to read. Errors or warnings are issued if the old name
1907		!! is being used.
1908
1909		! Local variables
1910		logical :: do_read, do_log
1911		logical :: new_name_used, old_name_used, same_value
1912		real :: new_name_value ! The value that is set when the old name is used.
1913
1914	1	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
1915	369	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
1916
1917	369	if (do_read) then
1918	369	if (present(default)) value = default
1919
1920	369	old_name_used = .false.
1921	369	if (present(old_name)) then
1922	0	new_name_value = value
1923	0	call read_param_real(CS, old_name, value, set=old_name_used)
1924	0	if (old_name_used) then
1925	0	call read_param_real(CS, varname, new_name_value, set=new_name_used)
1926
1927		! Issue appropriate warnings or error messages.
1928	0	same_value = (new_name_used .and. old_name_used .and. (value == new_name_value))
1929	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
1930		endif
1931		endif
1932
1933	369	if (.not.old_name_used) then ! Old name is either not present or not set.
1934	369	call read_param_real(CS, varname, value, fail_if_missing)
1935		endif
1936		endif
1937
1938	369	if (do_log) then
1939		call log_param_real(CS, modulename, varname, value, desc, units, &
1940	286	default, debuggingParam)
1941		endif
1942
1943	369	if (present(unscaled)) unscaled = value
1944	369	if (present(scale)) value = scale*value
1945
1946	369	end subroutine get_param_real
1947
1948		!> This subroutine reads the values of an array of real model parameters from a parameter file
1949		!! and logs them in documentation files.
1950	9	subroutine get_param_real_array(CS, modulename, varname, value, desc, units, &
1951	9	default, defaults, fail_if_missing, do_not_read, do_not_log, debuggingParam, &
1952	9	scale, unscaled, old_name)
1953		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
1954		!! it is also a structure to parse for run-time parameters
1955		character(len=*), intent(in) :: modulename !< The name of the calling module
1956		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
1957		real, dimension(:), intent(inout) :: value !< The value of the parameter that may be
1958		!! read from the parameter file and logged
1959		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
1960		!! present, this parameter is not written to a doc file
1961		character(len=*), intent(in) :: units !< The units of this parameter
1962		real, optional, intent(in) :: default !< A uniform default value of the parameter
1963		real, optional, intent(in) :: defaults(:) !< The element-wise defaults of the parameter
1964		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
1965		!! if this variable is not found in the parameter file
1966		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
1967		!! value for this parameter, although it might be logged.
1968		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
1969		!! parameter to the documentation files
1970		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
1971		!! logged in the debugging parameter file
1972		real, optional, intent(in) :: scale !< A scaling factor that the parameter is
1973		!! multiplied by before it is returned.
1974		real, dimension(:), optional, intent(out) :: unscaled !< The value of the parameter that would be
1975		!! returned without any multiplication by a scaling factor.
1976		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
1977		!! to read. Errors or warnings are issued if the old name
1978		!! is being used.
1979
1980		! Local variables
1981		logical :: do_read, do_log
1982		logical :: new_name_used, old_name_used, same_value
1983	18	real :: new_name_value(size(value)) ! The values that are set when the standard name is used.
1984		integer :: m
1985
1986	9	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
1987	9	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
1988
1989	9	if (present(defaults)) then
1990	8	if (present(default)) call MOM_error(FATAL, &
1991	0	"get_param_real_array: Only one of default and defaults can be specified at a time.")
1992	8	if (size(defaults) /= size(value)) call MOM_error(FATAL, &
1993	0	"get_param_real_array: The size of defaults and value are not the same.")
1994		endif
1995
1996	9	if (do_read) then
1997	9	if (present(default)) value(:) = default
1998	56	if (present(defaults)) value(:) = defaults(:)
1999
2000	9	old_name_used = .false.
2001	9	if (present(old_name)) then
2002	0	new_name_value(:) = value(:)
2003	0	call read_param_real_array(CS, old_name, value, set=old_name_used)
2004	0	if (old_name_used) then
2005	0	call read_param_real_array(CS, varname, new_name_value, set=new_name_used)
2006
2007		! Issue appropriate warnings or error messages.
2008	0	same_value = .true.
2009	0	do m=1,size(value) ; if (value(m) /= new_name_value(m)) same_value = .false. ; enddo
2010	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
2011		endif
2012		endif
2013
2014	9	if (.not.old_name_used) then ! Old name is either not present or not set.
2015	9	call read_param_real_array(CS, varname, value, fail_if_missing)
2016		endif
2017		endif
2018
2019	9	if (do_log) then
2020		call log_param_real_array(CS, modulename, varname, value, desc, &
2021	2	units, default, defaults, debuggingParam)
2022		endif
2023
2024	9	if (present(unscaled)) unscaled(:) = value(:)
2025	27	if (present(scale)) value(:) = scale*value(:)
2026
2027	9	end subroutine get_param_real_array
2028
2029		!> This subroutine reads the value of a character string model parameter from a parameter file
2030		!! and logs it in documentation files.
2031	61	subroutine get_param_char(CS, modulename, varname, value, desc, units, &
2032		default, fail_if_missing, do_not_read, do_not_log, &
2033		layoutParam, debuggingParam, old_name)
2034		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2035		!! it is also a structure to parse for run-time parameters
2036		character(len=*), intent(in) :: modulename !< The name of the calling module
2037		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
2038		character(len=*), intent(inout) :: value !< The value of the parameter that may be
2039		!! read from the parameter file and logged
2040		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
2041		!! present, this parameter is not written to a doc file
2042		character(len=*), optional, intent(in) :: units !< The units of this parameter
2043		character(len=*), optional, intent(in) :: default !< The default value of the parameter
2044		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
2045		!! if this variable is not found in the parameter file
2046		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
2047		!! value for this parameter, although it might be logged.
2048		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
2049		!! parameter to the documentation files
2050		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
2051		!! logged in the layout parameter file
2052		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
2053		!! logged in the debugging parameter file
2054		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
2055		!! to read. Errors or warnings are issued if the old name
2056		!! is being used.
2057
2058		! Local variables
2059		logical :: do_read, do_log
2060		logical :: new_name_used, old_name_used, same_value
2061	61	character(len=:), allocatable :: new_name_value ! The value that is set when the standard name is used.
2062
2063	0	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
2064	61	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
2065
2066	61	if (do_read) then
2067	61	if (present(default)) value = default
2068
2069	61	old_name_used = .false.
2070	61	if (present(old_name)) then
2071	0	new_name_value = value
2072	0	call read_param_char(CS, old_name, value, set=old_name_used)
2073	0	if (old_name_used) then
2074	0	call read_param_char(CS, varname, new_name_value, set=new_name_used)
2075
2076		! Issue appropriate warnings or error messages.
2077	0	same_value = (trim(value) == trim(new_name_value))
2078	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
2079		endif
2080		endif
2081
2082	61	if (.not.old_name_used) then ! Old name is either not present or not set.
2083	61	call read_param_char(CS, varname, value, fail_if_missing)
2084		endif
2085		endif
2086
2087	61	if (do_log) then
2088		call log_param_char(CS, modulename, varname, value, desc, units, &
2089	45	default, layoutParam, debuggingParam)
2090		endif
2091
2092	122	end subroutine get_param_char
2093
2094		!> This subroutine reads the values of an array of character string model parameters
2095		!! from a parameter file and logs them in documentation files.
2096	1	subroutine get_param_char_array(CS, modulename, varname, value, desc, units, &
2097		default, fail_if_missing, do_not_read, do_not_log, old_name)
2098		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2099		!! it is also a structure to parse for run-time parameters
2100		character(len=*), intent(in) :: modulename !< The name of the calling module
2101		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
2102		character(len=*), dimension(:), intent(inout) :: value !< The value of the parameter that may be
2103		!! read from the parameter file and logged
2104		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
2105		!! present, this parameter is not written to a doc file
2106		character(len=*), optional, intent(in) :: units !< The units of this parameter
2107		character(len=*), optional, intent(in) :: default !< The default value of the parameter
2108		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
2109		!! if this variable is not found in the parameter file
2110		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
2111		!! value for this parameter, although it might be logged.
2112		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
2113		!! parameter to the documentation files
2114		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
2115		!! to read. Errors or warnings are issued if the old name
2116		!! is being used.
2117
2118		! Local variables
2119		logical :: do_read, do_log
2120		logical :: new_name_used, old_name_used, same_value
2121		integer :: i, m, len_tot, len_val
2122	1	character(len=:), allocatable :: cat_val
2123	1	character(len=:), allocatable :: new_name_value(:) ! The value that is set when the standard name is used.
2124
2125	1	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
2126	1	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
2127
2128	1	if (do_read) then
2129	2	if (present(default)) value(:) = default
2130
2131	1	old_name_used = .false.
2132	1	if (present(old_name)) then
2133	0	new_name_value(:) = value(:)
2134	0	call read_param_char_array(CS, old_name, value, set=old_name_used)
2135	0	if (old_name_used) then
2136	0	call read_param_char_array(CS, varname, new_name_value, set=new_name_used)
2137
2138		! Issue appropriate warnings or error messages.
2139	0	same_value = .true.
2140	0	do m=1,size(value) ; if (trim(value(m)) /= trim(new_name_value(m))) same_value = .false. ; enddo
2141	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
2142		endif
2143		endif
2144
2145	1	if (.not.old_name_used) then ! Old name is either not present or not set.
2146	1	call read_param_char_array(CS, varname, value, fail_if_missing)
2147		endif
2148		endif
2149
2150	1	if (do_log) then
2151	1	cat_val = trim(value(1)) ; len_tot = len_trim(value(1))
2152	1	do i=2,size(value)
2153	0	len_val = len_trim(value(i))
2154	1	if ((len_val > 0) .and. (len_tot + len_val + 2 < 240)) then
2155	0	cat_val = trim(cat_val)//ACHAR(34)// ", "//ACHAR(34)//trim(value(i))
2156	0	len_tot = len_tot + len_val
2157		endif
2158		enddo
2159		call log_param_char(CS, modulename, varname, cat_val, desc, &
2160	1	units, default)
2161		endif
2162
2163	2	end subroutine get_param_char_array
2164
2165		!> This subroutine reads the value of a logical model parameter from a parameter file
2166		!! and logs it in documentation files.
2167	548	subroutine get_param_logical(CS, modulename, varname, value, desc, units, &
2168		default, fail_if_missing, do_not_read, do_not_log, &
2169		layoutParam, debuggingParam, old_name)
2170		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2171		!! it is also a structure to parse for run-time parameters
2172		character(len=*), intent(in) :: modulename !< The name of the calling module
2173		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
2174		logical, intent(inout) :: value !< The value of the parameter that may be
2175		!! read from the parameter file and logged
2176		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
2177		!! present, this parameter is not written to a doc file
2178		character(len=*), optional, intent(in) :: units !< The units of this parameter
2179		logical, optional, intent(in) :: default !< The default value of the parameter
2180		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
2181		!! if this variable is not found in the parameter file
2182		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
2183		!! value for this parameter, although it might be logged.
2184		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
2185		!! parameter to the documentation files
2186		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
2187		!! logged in the layout parameter file
2188		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
2189		!! logged in the debugging parameter file
2190		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
2191		!! to read. Errors or warnings are issued if the old name
2192		!! is being used.
2193
2194		! Local variables
2195		logical :: do_read, do_log
2196		logical :: new_name_used, old_name_used, same_value
2197		logical :: new_name_value ! The value that is set when the standard name is used.
2198
2199	1	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
2200	548	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
2201
2202	548	if (do_read) then
2203	548	if (present(default)) value = default
2204
2205	548	old_name_used = .false.
2206	548	if (present(old_name)) then
2207	1	new_name_value = value
2208	1	call read_param_logical(CS, old_name, value, set=old_name_used)
2209	1	if (old_name_used) then
2210	0	call read_param_logical(CS, varname, new_name_value, set=new_name_used)
2211
2212		! Issue appropriate warnings or error messages.
2213	0	same_value = (value .eqv. new_name_value)
2214	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
2215		endif
2216		endif
2217
2218	548	if (.not.old_name_used) then ! Old name is either not present or not set.
2219	548	call read_param_logical(CS, varname, value, fail_if_missing)
2220		endif
2221		endif
2222
2223	548	if (do_log) then
2224		call log_param_logical(CS, modulename, varname, value, desc, &
2225	386	units, default, layoutParam, debuggingParam)
2226		endif
2227
2228	548	end subroutine get_param_logical
2229
2230		!> This subroutine reads the value of a time-type model parameter from a parameter file
2231		!! and logs it in documentation files.
2232	4	subroutine get_param_time(CS, modulename, varname, value, desc, units, &
2233		default, fail_if_missing, do_not_read, do_not_log, &
2234		timeunit, layoutParam, debuggingParam, &
2235		log_as_date, old_name)
2236		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2237		!! it is also a structure to parse for run-time parameters
2238		character(len=*), intent(in) :: modulename !< The name of the calling module
2239		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
2240		type(time_type), intent(inout) :: value !< The value of the parameter that may be
2241		!! read from the parameter file and logged
2242		character(len=*), optional, intent(in) :: desc !< A description of this variable; if not
2243		!! present, this parameter is not written to a doc file
2244		character(len=*), optional, intent(in) :: units !< The units of this parameter
2245		type(time_type), optional, intent(in) :: default !< The default value of the parameter
2246		logical, optional, intent(in) :: fail_if_missing !< If present and true, a fatal error occurs
2247		!! if this variable is not found in the parameter file
2248		logical, optional, intent(in) :: do_not_read !< If present and true, do not read a
2249		!! value for this parameter, although it might be logged.
2250		logical, optional, intent(in) :: do_not_log !< If present and true, do not log this
2251		!! parameter to the documentation files
2252		real, optional, intent(in) :: timeunit !< The number of seconds in a time unit for
2253		!! real-number input to be translated to a time.
2254		logical, optional, intent(in) :: layoutParam !< If present and true, this parameter is
2255		!! logged in the layout parameter file
2256		logical, optional, intent(in) :: debuggingParam !< If present and true, this parameter is
2257		!! logged in the debugging parameter file
2258		logical, optional, intent(in) :: log_as_date !< If true, log the time_type in date
2259		!! format. The default is false.
2260		character(len=*), optional, intent(in) :: old_name !< A case-sensitive archaic name of the parameter
2261		!! to read. Errors or warnings are issued if the old name
2262		!! is being used.
2263
2264		! Local variables
2265		logical :: do_read, do_log, log_date
2266		logical :: new_name_used, old_name_used, same_value
2267		type(time_type) :: new_name_value ! The value that is set when the standard name is used.
2268
2269	0	do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read
2270	4	do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log
2271	4	log_date = .false.
2272
2273	4	if (do_read) then
2274	4	if (present(default)) value = default
2275
2276	4	old_name_used = .false.
2277	4	if (present(old_name)) then
2278	0	new_name_value = value
2279	0	call read_param_time(CS, old_name, value, timeunit, date_format=log_date, set=old_name_used)
2280	0	if (old_name_used) then
2281	0	call read_param_time(CS, varname, new_name_value, timeunit, date_format=log_date, set=new_name_used)
2282
2283		! Issue appropriate warnings or error messages.
2284	0	same_value = (value == new_name_value)
2285	0	call archaic_param_name_message(varname, old_name, new_name_used, same_value)
2286		endif
2287		endif
2288
2289	4	if (.not.old_name_used) then ! Old name is either not present or not set.
2290	4	call read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format=log_date)
2291		endif
2292		endif
2293
2294	4	if (do_log) then
2295	4	if (present(log_as_date)) log_date = log_as_date
2296		call log_param_time(CS, modulename, varname, value, desc, units, default, &
2297		timeunit, layoutParam=layoutParam, &
2298	4	debuggingParam=debuggingParam, log_date=log_date)
2299		endif
2300
2301	4	end subroutine get_param_time
2302
2303		!> Issue error messages or warnings about the use of an archaic parameter name.
2304	0	subroutine archaic_param_name_message(varname, old_name, new_name_used, same_value)
2305		character(len=*), intent(in) :: varname !< The case-sensitive name of the parameter to read
2306		character(len=*), intent(in) :: old_name !< The case-sensitive archaic name of the parameter
2307		logical, intent(in) :: new_name_used !< True if varname is used in the parameter file.
2308		logical, intent(in) :: same_value !< True if varname and old_name give the same values.
2309
2310	0	if (new_name_used .and. same_value) then
2311		call MOM_error(WARNING, "The runtime parameter "//trim(varname)//&
2312		" is also being set consistently via its older name of "//trim(old_name)//&
2313	0	". Please migrate to only using "//trim(varname)//".")
2314	0	elseif (new_name_used .and. .not.same_value) then
2315		call MOM_error(FATAL, "The runtime parameter "//trim(varname)//&
2316		" is also being set inconsistently via its older name of "//trim(old_name)//&
2317	0	". Only use "//trim(varname)//".")
2318		else
2319		call MOM_error(WARNING, "The runtime parameter "//trim(varname)//&
2320		" is being set via its soon to be obsolete name of "//trim(old_name)//&
2321	0	". Please migrate to using "//trim(varname)//".")
2322		endif
2323	0	end subroutine archaic_param_name_message
2324
2325		! -----------------------------------------------------------------------------
2326
2327		!> Resets the parameter block name to blank
2328	0	subroutine clearParameterBlock(CS)
2329		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2330		!! it is also a structure to parse for run-time parameters
2331
2332		type(parameter_block), pointer :: block => NULL()
2333	0	if (associated(CS%blockName)) then
2334	0	block => CS%blockName
2335	0	block%name = ''
2336		else
2337	0	if (is_root_pe()) call MOM_error(FATAL, &
2338	0	'clearParameterBlock: A clear was attempted before allocation.')
2339		endif
2340	0	end subroutine clearParameterBlock
2341
2342		!> Tags blockName onto the end of the active parameter block name
2343	3	subroutine openParameterBlock(CS, blockName, desc, do_not_log)
2344		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2345		!! it is also a structure to parse for run-time parameters
2346		character(len=*), intent(in) :: blockName !< The name of a parameter block being added
2347		character(len=*), optional, intent(in) :: desc !< A description of the parameter block being added
2348		logical, optional, intent(in) :: do_not_log
2349		!< Log block entry if true. This only prevents logging of entry to the block, and not the contents.
2350
2351		type(parameter_block), pointer :: block => NULL()
2352		logical :: do_log
2353
2354	3	do_log = .true.
2355	2	if (present(do_not_log)) do_log = .not. do_not_log
2356
2357	3	if (associated(CS%blockName)) then
2358	3	block => CS%blockName
2359	3	block%name = pushBlockLevel(block%name,blockName)
2360	3	if (do_log) then
2361	1	call doc_openBlock(CS%doc, block%name, desc)
2362	1	block%log_access = .true.
2363		else
2364	2	block%log_access = .false.
2365		endif
2366		else
2367	0	if (is_root_pe()) call MOM_error(FATAL, &
2368	0	'openParameterBlock: A push was attempted before allocation.')
2369		endif
2370	3	end subroutine openParameterBlock
2371
2372		!> Remove the lowest level of recursion from the active block name
2373	3	subroutine closeParameterBlock(CS)
2374		type(param_file_type), intent(in) :: CS !< The control structure for the file_parser module,
2375		!! it is also a structure to parse for run-time parameters
2376
2377		type(parameter_block), pointer :: block => NULL()
2378
2379	3	if (associated(CS%blockName)) then
2380	3	block => CS%blockName
2381	3	if (is_root_pe().and.len_trim(block%name)==0) call MOM_error(FATAL, &
2382		'closeParameterBlock: A pop was attempted on an empty stack. ("'//&
2383	0	trim(block%name)//'")')
2384	3	if (block%log_access) call doc_closeBlock(CS%doc, block%name)
2385		else
2386	0	if (is_root_pe()) call MOM_error(FATAL, &
2387	0	'closeParameterBlock: A pop was attempted before allocation.')
2388		endif
2389	3	block%name = popBlockLevel(block%name)
2390	3	end subroutine closeParameterBlock
2391
2392		!> Extends block name (deeper level of parameter block)
2393	1207	function pushBlockLevel(oldblockName,newBlockName)
2394		character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names
2395		character(len=*), intent(in) :: newBlockName !< A new block name to add to the end of the sequence
2396		character(len=len(oldBlockName)+40) :: pushBlockLevel
2397
2398	1207	if (len_trim(oldBlockName)>0) then
2399	0	pushBlockLevel=trim(oldBlockName)//'%'//trim(newBlockName)
2400		else
2401	1207	pushBlockLevel=trim(newBlockName)
2402		endif
2403	1207	end function pushBlockLevel
2404
2405		!> Truncates block name (shallower level of parameter block)
2406	1207	function popBlockLevel(oldblockName)
2407		character(len=*), intent(in) :: oldBlockName !< A sequence of hierarchical parameter block names
2408		character(len=len(oldBlockName)+40) :: popBlockLevel
2409
2410		integer :: i
2411	1207	i = index(trim(oldBlockName), '%', .true.)
2412	1207	if (i>1) then
2413	0	popBlockLevel = trim(oldBlockName(1:i-1))
2414	1207	elseif (i==0) then
2415	1207	popBlockLevel = ''
2416		else ! i==1
2417	0	if (is_root_pe()) call MOM_error(FATAL, &
2418	0	'popBlockLevel: A pop was attempted leaving an empty block name.')
2419		endif
2420	1207	end function popBlockLevel
2421
2422		!> \namespace mom_file_parser
2423		!!
2424		!! By Robert Hallberg and Alistair Adcroft, updated 9/2013.
2425		!!
2426		!! The subroutines here parse a set of input files for the value
2427		!! a named parameter and sets that parameter at run time. Currently
2428		!! these files use use one of several formats:
2429		!! \#define VAR ! To set the logical VAR to true.
2430		!! VAR = True ! To set the logical VAR to true.
2431		!! \#undef VAR ! To set the logical VAR to false.
2432		!! VAR = False ! To set the logical VAR to false.
2433		!! \#define VAR 999 ! To set the real or integer VAR to 999.
2434		!! VAR = 999 ! To set the real or integer VAR to 999.
2435		!! \#override VAR = 888 ! To override a previously set value.
2436		!! VAR = 1.1, 2.2, 3.3 ! To set an array of real values.
2437		! Note that in the comments above, dOxygen translates \# to # .
2438		!!
2439		!! In addition, when set by the get_param interface, the values of
2440		!! parameters are automatically logged, along with defaults, units,
2441		!! and a description. It is an error for a variable to be overridden
2442		!! more than once, and MOM6 has a facility to check for unused lines
2443		!! to set variables, which may indicate miss-spelled or archaic
2444		!! parameters. Parameter names are case-specific, and lines may use
2445		!! a F90 or C++ style comment, starting with ! or //.
2446
2447	0	end module MOM_file_parser