6 use mom_coms, only : root_pe, broadcast
10 use mom_time_manager, only : set_date, get_date, real_to_time,
operator(-), set_time
16 implicit none ;
private 18 integer,
parameter,
public :: max_param_files = 5
19 integer,
parameter :: input_str_length = 320
20 integer,
parameter :: filename_length = 200
23 logical :: all_pes_read = .false.
27 logical,
parameter :: report_unused_default = .true.
28 logical,
parameter :: unused_params_fatal_default = .false.
29 logical,
parameter :: log_to_stdout_default = .false.
30 logical,
parameter :: complete_doc_default = .true.
31 logical,
parameter :: minimal_doc_default = .true.
36 integer :: num_lines = 0
37 character(len=INPUT_STR_LENGTH),
pointer,
dimension(:) :: line => null()
38 logical,
pointer,
dimension(:) :: line_used => null()
44 character(len=80) :: name
45 logical :: hasissuedoverridewarning = .false.
50 character(len=240) :: name =
'' 56 integer :: iounit(max_param_files)
57 character(len=FILENAME_LENGTH) :: filename(max_param_files)
58 logical :: netcdf_file(max_param_files)
64 logical :: report_unused = report_unused_default
66 logical :: unused_params_fatal = unused_params_fatal_default
68 logical :: log_to_stdout = log_to_stdout_default
70 logical :: log_open = .false.
73 character(len=240) :: doc_file
75 logical :: complete_doc = complete_doc_default
77 logical :: minimal_doc = minimal_doc_default
87 public clearparameterblock, openparameterblock, closeparameterblock
91 module procedure read_param_int, read_param_real, read_param_logical, &
92 read_param_char, read_param_char_array, read_param_time, &
93 read_param_int_array, read_param_real_array
97 module procedure log_param_int, log_param_real, log_param_logical, &
98 log_param_char, log_param_time, &
99 log_param_int_array, log_param_real_array
103 module procedure get_param_int, get_param_real, get_param_logical, &
104 get_param_char, get_param_char_array, get_param_time, &
105 get_param_int_array, get_param_real_array
110 module procedure log_version_cs, log_version_plain
116 subroutine open_param_file(filename, CS, checkable, component, doc_file_dir)
117 character(len=*),
intent(in) :: filename
120 logical,
optional,
intent(in) :: checkable
122 character(len=*),
optional,
intent(in) :: component
124 character(len=*),
optional,
intent(in) :: doc_file_dir
128 logical :: file_exists, unit_in_use, Netcdf_file, may_check
129 integer :: ios, iounit, strlen, i
130 character(len=240) :: doc_path
133 may_check = .true. ;
if (
present(checkable)) may_check = checkable
136 strlen = len_trim(filename)
137 if (strlen == 0)
then 138 call mom_error(fatal,
"open_param_file: Input file has not been specified.")
142 if (cs%nfiles > 0)
then 143 inquire(file=trim(filename), number=iounit)
144 if (iounit /= -1)
then 146 if (cs%iounit(i) == iounit)
then 147 if (trim(cs%filename(1)) /= trim(filename))
then 148 call mom_error(fatal, &
149 "open_param_file: internal inconsistency! "//trim(filename)// &
150 " is registered as open but has the wrong unit number!")
152 call mom_error(warning, &
153 "open_param_file: file "//trim(filename)// &
154 " has already been opened. This should NOT happen!"// &
155 " Did you specify the same file twice in a namelist?")
164 inquire(file=trim(filename), exist=file_exists)
165 if (.not.file_exists)
call mom_error(fatal, &
166 "open_param_file: Input file "// trim(filename)//
" does not exist.")
168 netcdf_file = .false.
170 if (filename(strlen-2:strlen) ==
".nc") netcdf_file = .true.
174 call mom_error(fatal,
"open_param_file: NetCDF files are not yet supported.")
176 if (all_pes_read .or. is_root_pe())
then 179 INQUIRE(iounit,opened=unit_in_use) ;
if (.not.unit_in_use)
exit 181 if (iounit >= 512)
call mom_error(fatal, &
182 "open_param_file: No unused file unit could be found.")
185 open(iounit, file=trim(filename), access=
'SEQUENTIAL', &
186 form=
'FORMATTED', action=
'READ', position=
'REWIND', iostat=ios)
187 if (ios /= 0)
call mom_error(fatal,
"open_param_file: Error opening "// &
196 cs%iounit(i) = iounit
197 cs%filename(i) = filename
198 cs%NetCDF_file(i) = netcdf_file
199 allocate(block) ; block%name =
'' ; cs%blockName => block
201 call mom_mesg(
"open_param_file: "// trim(filename)// &
202 " has been opened successfully.", 5)
204 call populate_param_data(iounit, filename, cs%param_data(i))
206 call read_param(cs,
"SEND_LOG_TO_STDOUT",cs%log_to_stdout)
207 call read_param(cs,
"REPORT_UNUSED_PARAMS",cs%report_unused)
208 call read_param(cs,
"FATAL_UNUSED_PARAMS",cs%unused_params_fatal)
209 cs%doc_file =
"MOM_parameter_doc" 210 if (
present(component)) cs%doc_file = trim(component)//
"_parameter_doc" 211 call read_param(cs,
"DOCUMENT_FILE", cs%doc_file)
212 if (.not.may_check)
then 213 cs%report_unused = .false.
214 cs%unused_params_fatal = .false.
218 cs%stdlog = stdlog() ; cs%stdout = stdout()
219 cs%log_open = (stdlog() > 0)
221 doc_path = cs%doc_file
222 if (len_trim(cs%doc_file) > 0)
then 223 cs%complete_doc = complete_doc_default
224 call read_param(cs,
"COMPLETE_DOCUMENTATION", cs%complete_doc)
225 cs%minimal_doc = minimal_doc_default
226 call read_param(cs,
"MINIMAL_DOCUMENTATION", cs%minimal_doc)
227 if (
present(doc_file_dir))
then ;
if (len_trim(doc_file_dir) > 0)
then 228 doc_path = trim(slasher(doc_file_dir))//trim(cs%doc_file)
231 cs%complete_doc = .false.
232 cs%minimal_doc = .false.
234 call doc_init(doc_path, cs%doc, minimal=cs%minimal_doc, complete=cs%complete_doc, &
235 layout=cs%complete_doc, debugging=cs%complete_doc)
237 end subroutine open_param_file
241 subroutine close_param_file(CS, quiet_close, component)
244 logical,
optional,
intent(in) :: quiet_close
246 character(len=*),
optional,
intent(in) :: component
249 logical :: all_default
250 character(len=128) :: docfile_default
251 character(len=40) :: mdl
253 # include "version_variable.h" 254 integer :: i, n, num_unused
256 if (
present(quiet_close))
then ;
if (quiet_close)
then 258 if (all_pes_read .or. is_root_pe())
close(cs%iounit(i))
259 call mom_mesg(
"close_param_file: "// trim(cs%filename(i))// &
260 " has been closed successfully.", 5)
263 cs%NetCDF_file(i) = .false.
264 deallocate (cs%param_data(i)%line)
265 deallocate (cs%param_data(i)%line_used)
267 cs%log_open = .false.
273 docfile_default =
"MOM_parameter_doc" 274 if (
present(component)) docfile_default = trim(component)//
"_parameter_doc" 276 all_default = (cs%log_to_stdout .eqv. log_to_stdout_default)
277 all_default = all_default .and. (trim(cs%doc_file) == trim(docfile_default))
278 if (len_trim(cs%doc_file) > 0)
then 279 all_default = all_default .and. (cs%complete_doc .eqv. complete_doc_default)
280 all_default = all_default .and. (cs%minimal_doc .eqv. minimal_doc_default)
283 mdl =
"MOM_file_parser" 284 call log_version(cs, mdl, version,
"", debugging=.true., log_to_all=.true., all_default=all_default)
285 call log_param(cs, mdl,
"SEND_LOG_TO_STDOUT", cs%log_to_stdout, &
286 "If true, all log messages are also sent to stdout.", &
287 default=log_to_stdout_default)
288 call log_param(cs, mdl,
"REPORT_UNUSED_PARAMS", cs%report_unused, &
289 "If true, report any parameter lines that are not used "//&
290 "in the run.", default=report_unused_default, &
291 debuggingparam=.true.)
292 call log_param(cs, mdl,
"FATAL_UNUSED_PARAMS", cs%unused_params_fatal, &
293 "If true, kill the run if there are any unused "//&
294 "parameters.", default=unused_params_fatal_default, &
295 debuggingparam=.true.)
296 call log_param(cs, mdl,
"DOCUMENT_FILE", cs%doc_file, &
297 "The basename for files where run-time parameters, their "//&
298 "settings, units and defaults are documented. Blank will "//&
299 "disable all parameter documentation.", default=docfile_default)
300 if (len_trim(cs%doc_file) > 0)
then 301 call log_param(cs, mdl,
"COMPLETE_DOCUMENTATION", cs%complete_doc, &
302 "If true, all run-time parameters are "//&
303 "documented in "//trim(cs%doc_file)//&
304 ".all .", default=complete_doc_default)
305 call log_param(cs, mdl,
"MINIMAL_DOCUMENTATION", cs%minimal_doc, &
306 "If true, non-default run-time parameters are "//&
307 "documented in "//trim(cs%doc_file)//&
308 ".short .", default=minimal_doc_default)
313 if (is_root_pe() .and. (cs%report_unused .or. &
314 cs%unused_params_fatal))
then 316 do n=1,cs%param_data(i)%num_lines
317 if (.not.cs%param_data(i)%line_used(n))
then 318 num_unused = num_unused + 1
319 if (cs%report_unused) &
320 call mom_error(warning,
"Unused line in "//trim(cs%filename(i))// &
321 " : "//trim(cs%param_data(i)%line(n)))
326 if (all_pes_read .or. is_root_pe())
close(cs%iounit(i))
327 call mom_mesg(
"close_param_file: "// trim(cs%filename(i))// &
328 " has been closed successfully.", 5)
331 cs%NetCDF_file(i) = .false.
332 deallocate (cs%param_data(i)%line)
333 deallocate (cs%param_data(i)%line_used)
336 if (is_root_pe() .and. (num_unused>0) .and. cs%unused_params_fatal) &
337 call mom_error(fatal,
"Run stopped because of unused parameter lines.")
339 cs%log_open = .false.
342 end subroutine close_param_file
346 subroutine populate_param_data(iounit, filename, param_data)
347 integer,
intent(in) :: iounit
348 character(len=*),
intent(in) :: filename
353 character(len=INPUT_STR_LENGTH) :: line
355 logical :: inMultiLineComment
361 if (iounit <= 0)
return 363 if (all_pes_read .or. is_root_pe())
then 369 inmultilinecomment = .false.
371 read(iounit,
'(a)', end=8, err=9) line
372 line = replacetabs(line)
373 if (inmultilinecomment)
then 374 if (closemultilinecomment(line)) inmultilinecomment=.false.
376 if (lastnoncommentnonblank(line)>0) num_lines = num_lines + 1
377 if (openmultilinecomment(line)) inmultilinecomment=.true.
382 if (inmultilinecomment .and. is_root_pe()) &
383 call mom_error(fatal,
'MOM_file_parser : A C-style multi-line comment '// &
384 '(/* ... */) was not closed before the end of '//trim(filename))
387 param_data%num_lines = num_lines
391 if (.not. all_pes_read)
then 392 call broadcast(param_data%num_lines, root_pe())
396 num_lines = param_data%num_lines
397 allocate (param_data%line(num_lines))
398 allocate (param_data%line_used(num_lines))
399 param_data%line(:) =
' ' 400 param_data%line_used(:) = .false.
403 if (all_pes_read .or. is_root_pe())
then 410 read(iounit,
'(a)', end=18, err=9) line
411 line = replacetabs(line)
412 if (inmultilinecomment)
then 413 if (closemultilinecomment(line)) inmultilinecomment=.false.
415 if (lastnoncommentnonblank(line)>0)
then 416 line = removecomments(line)
417 line = simplifywhitespace(line(:len_trim(line)))
418 num_lines = num_lines + 1
419 param_data%line(num_lines) = line
421 if (openmultilinecomment(line)) inmultilinecomment=.true.
426 if (num_lines /= param_data%num_lines) &
427 call mom_error(fatal,
'MOM_file_parser : Found different number of '// &
428 'valid lines on second reading of '//trim(filename))
432 if (.not. all_pes_read)
then 433 call broadcast(param_data%line, input_str_length, root_pe())
438 9
call mom_error(fatal,
"MOM_file_parser : "//&
439 "Error while reading file "//trim(filename))
441 end subroutine populate_param_data
445 function openmultilinecomment(string)
446 character(len=*),
intent(in) :: string
447 logical :: openMultiLineComment
450 integer :: icom, last
452 openmultilinecomment = .false.
453 last = lastnoncommentindex(string)+1
454 icom = index(string(last:),
"/*")
456 openmultilinecomment=.true.
459 icom = index(string(last:),
"*/") ;
if (icom > 0) openmultilinecomment=.false.
460 end function openmultilinecomment
463 function closemultilinecomment(string)
464 character(len=*),
intent(in) :: string
465 logical :: closeMultiLineComment
467 closemultilinecomment = .false.
468 if (index(string,
"*/")>0) closemultilinecomment=.true.
469 end function closemultilinecomment
473 function lastnoncommentindex(string)
474 character(len=*),
intent(in) :: string
475 integer :: lastNonCommentIndex
478 integer :: icom, last
481 last = len_trim(string)
482 icom = index(string(:last),
"!") ;
if (icom > 0) last = icom-1
483 icom = index(string(:last),
"//") ;
if (icom > 0) last = icom-1
484 icom = index(string(:last),
"/*") ;
if (icom > 0) last = icom-1
485 lastnoncommentindex = last
486 end function lastnoncommentindex
489 function lastnoncommentnonblank(string)
490 character(len=*),
intent(in) :: string
491 integer :: lastNonCommentNonBlank
493 lastnoncommentnonblank = len_trim(string(:lastnoncommentindex(string)))
494 end function lastnoncommentnonblank
497 function replacetabs(string)
498 character(len=*),
intent(in) :: string
499 character(len=len(string)) :: replaceTabs
504 if (string(i:i)==achar(9))
then 507 replacetabs(i:i)=string(i:i)
510 end function replacetabs
513 function removecomments(string)
514 character(len=*),
intent(in) :: string
515 character(len=len(string)) :: removeComments
519 removecomments=repeat(
" ",len(string))
520 last = lastnoncommentnonblank(string)
521 removecomments(:last)=adjustl(string(:last))
522 end function removecomments
526 function simplifywhitespace(string)
527 character(len=*),
intent(in) :: string
528 character(len=len(string)+16) :: simplifyWhiteSpace
532 logical :: nonBlank = .false., insidestring = .false.
533 character(len=1) :: quoteChar=
" " 535 nonblank = .false.; insidestring = .false.
537 simplifywhitespace=repeat(
" ",len(string)+16)
538 do j=1,len_trim(string)
539 if (insidestring)
then 541 simplifywhitespace(i:i)=string(j:j)
542 if (string(j:j)==quotechar) insidestring=.false.
544 if (string(j:j)==
" " .or. string(j:j)==achar(9))
then 547 simplifywhitespace(i:i)=
" " 550 elseif (string(j:j)==
'"' .or. string(j:j)==
"'")
then 552 simplifywhitespace(i:i)=string(j:j)
554 quotechar=string(j:j)
556 elseif (string(j:j)==
'=')
then 560 simplifywhitespace(i:i)=
" " 563 simplifywhitespace(i-1:i)=string(j:j)//
" " 567 simplifywhitespace(i:i)=string(j:j)
572 if (insidestring)
then 573 if (is_root_pe())
call mom_error(fatal, &
574 "There is a mismatched quote in the parameter file line: "// &
577 end function simplifywhitespace
580 subroutine read_param_int(CS, varname, value, fail_if_missing)
583 character(len=*),
intent(in) :: varname
584 integer,
intent(inout) ::
value 586 logical,
optional,
intent(in) :: fail_if_missing
589 character(len=INPUT_STR_LENGTH) :: value_string(1)
590 logical :: found, defined
592 call get_variable_line(cs, varname, found, defined, value_string)
593 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then 594 read(value_string(1),*,err = 1001)
value 596 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 598 call mom_error(fatal,
'read_param_int: Unable to find variable '//trim(varname)// &
599 ' in any input files.')
601 call mom_error(fatal,
'read_param_int: Variable '//trim(varname)// &
602 ' found but not set in input files.')
607 1001
call mom_error(fatal,
'read_param_int: read error for integer variable '//trim(varname)// &
608 ' parsing "'//trim(value_string(1))//
'"')
609 end subroutine read_param_int
612 subroutine read_param_int_array(CS, varname, value, fail_if_missing)
615 character(len=*),
intent(in) :: varname
616 integer,
dimension(:),
intent(inout) ::
value 618 logical,
optional,
intent(in) :: fail_if_missing
621 character(len=INPUT_STR_LENGTH) :: value_string(1)
622 logical :: found, defined
624 call get_variable_line(cs, varname, found, defined, value_string)
625 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then 626 read(value_string(1),*,end=991,err=1002)
value 629 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 631 call mom_error(fatal,
'read_param_int_array: Unable to find variable '//trim(varname)// &
632 ' in any input files.')
634 call mom_error(fatal,
'read_param_int_array: Variable '//trim(varname)// &
635 ' found but not set in input files.')
640 1002
call mom_error(fatal,
'read_param_int_array: read error for integer array '//trim(varname)// &
641 ' parsing "'//trim(value_string(1))//
'"')
642 end subroutine read_param_int_array
645 subroutine read_param_real(CS, varname, value, fail_if_missing, scale)
648 character(len=*),
intent(in) :: varname
649 real,
intent(inout) ::
value 651 logical,
optional,
intent(in) :: fail_if_missing
653 real,
optional,
intent(in) :: scale
657 character(len=INPUT_STR_LENGTH) :: value_string(1)
658 logical :: found, defined
660 call get_variable_line(cs, varname, found, defined, value_string)
661 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then 662 read(value_string(1),*,err=1003)
value 663 if (
present(scale))
value = scale*
value 665 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 667 call mom_error(fatal,
'read_param_real: Unable to find variable '//trim(varname)// &
668 ' in any input files.')
670 call mom_error(fatal,
'read_param_real: Variable '//trim(varname)// &
671 ' found but not set in input files.')
676 1003
call mom_error(fatal,
'read_param_real: read error for real variable '//trim(varname)// &
677 ' parsing "'//trim(value_string(1))//
'"')
678 end subroutine read_param_real
681 subroutine read_param_real_array(CS, varname, value, fail_if_missing, scale)
684 character(len=*),
intent(in) :: varname
685 real,
dimension(:),
intent(inout) ::
value 687 logical,
optional,
intent(in) :: fail_if_missing
689 real,
optional,
intent(in) :: scale
693 character(len=INPUT_STR_LENGTH) :: value_string(1)
694 logical :: found, defined
696 call get_variable_line(cs, varname, found, defined, value_string)
697 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then 698 read(value_string(1),*,end=991,err=1004)
value 700 if (
present(scale)) value(:) = scale*value(:)
703 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 705 call mom_error(fatal,
'read_param_real_array: Unable to find variable '//trim(varname)// &
706 ' in any input files.')
708 call mom_error(fatal,
'read_param_real_array: Variable '//trim(varname)// &
709 ' found but not set in input files.')
714 1004
call mom_error(fatal,
'read_param_real_array: read error for real array '//trim(varname)// &
715 ' parsing "'//trim(value_string(1))//
'"')
716 end subroutine read_param_real_array
719 subroutine read_param_char(CS, varname, value, fail_if_missing)
722 character(len=*),
intent(in) :: varname
723 character(len=*),
intent(inout) ::
value 725 logical,
optional,
intent(in) :: fail_if_missing
728 character(len=INPUT_STR_LENGTH) :: value_string(1)
729 logical :: found, defined
731 call get_variable_line(cs, varname, found, defined, value_string)
733 value = trim(strip_quotes(value_string(1)))
734 elseif (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 735 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
736 ' in any input files.')
739 end subroutine read_param_char
742 subroutine read_param_char_array(CS, varname, value, fail_if_missing)
745 character(len=*),
intent(in) :: varname
746 character(len=*),
dimension(:),
intent(inout) ::
value 748 logical,
optional,
intent(in) :: fail_if_missing
752 character(len=INPUT_STR_LENGTH) :: value_string(1), loc_string
753 logical :: found, defined
756 call get_variable_line(cs, varname, found, defined, value_string)
758 loc_string = trim(value_string(1))
759 i = index(loc_string,
",")
762 value(i_out) = trim(strip_quotes(loc_string(:i-1)))
764 loc_string = trim(adjustl(loc_string(i+1:)))
765 i = index(loc_string,
",")
767 if (len_trim(loc_string)>0)
then 768 value(i_out) = trim(strip_quotes(adjustl(loc_string)))
771 do i=i_out,
SIZE(
value) ; value(i) =
" " ;
enddo 772 elseif (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 773 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
774 ' in any input files.')
777 end subroutine read_param_char_array
780 subroutine read_param_logical(CS, varname, value, fail_if_missing)
783 character(len=*),
intent(in) :: varname
784 logical,
intent(inout) ::
value 786 logical,
optional,
intent(in) :: fail_if_missing
790 character(len=INPUT_STR_LENGTH) :: value_string(1)
791 logical :: found, defined
793 call get_variable_line(cs, varname, found, defined, value_string, paramislogical=.true.)
796 elseif (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 797 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
798 ' in any input files.')
800 end subroutine read_param_logical
803 subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format)
806 character(len=*),
intent(in) :: varname
807 type(time_type),
intent(inout) ::
value 809 real,
optional,
intent(in) :: timeunit
810 logical,
optional,
intent(in) :: fail_if_missing
812 logical,
optional,
intent(out) :: date_format
817 character(len=INPUT_STR_LENGTH) :: value_string(1)
818 character(len=240) :: err_msg
819 logical :: found, defined
820 real :: real_time, time_unit
823 if (
present(date_format)) date_format = .false.
825 call get_variable_line(cs, varname, found, defined, value_string)
826 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then 829 if ((index(value_string(1),
'-') > 0) .and. &
830 (index(value_string(1),
'-',back=.true.) > index(value_string(1),
'-')))
then 832 value = set_date(value_string(1), err_msg=err_msg)
833 if (len_trim(err_msg) > 0)
call mom_error(fatal,
'read_param_time: '//&
834 trim(err_msg)//
' in integer list read error for time-type variable '//&
835 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
836 if (
present(date_format)) date_format = .true.
837 elseif (index(value_string(1),
',') > 0)
then 839 vals(:) = (/ -999, -999, -999, 0, 0, 0, 0 /)
840 read(value_string(1),*,end=995,err=1005) vals
842 if ((vals(1) < 0) .or. (vals(2) < 0) .or. (vals(3) < 0)) &
843 call mom_error(fatal,
'read_param_time: integer list read error for time-type variable '//&
844 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
845 value = set_date(vals(1), vals(2), vals(3), vals(4), vals(5), vals(6), &
846 vals(7), err_msg=err_msg)
847 if (len_trim(err_msg) > 0)
call mom_error(fatal,
'read_param_time: '//&
848 trim(err_msg)//
' in integer list read error for time-type variable '//&
849 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
850 if (
present(date_format)) date_format = .true.
852 time_unit = 1.0 ;
if (
present(timeunit)) time_unit = timeunit
853 read( value_string(1), *) real_time
854 value = real_to_time(real_time*time_unit)
857 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then 859 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
860 ' in any input files.')
862 call mom_error(fatal,
'Variable '//trim(varname)// &
863 ' found but not set in input files.')
868 1005
call mom_error(fatal,
'read_param_time: read error for time-type variable '//&
869 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
870 end subroutine read_param_time
873 function strip_quotes(val_str)
874 character(len=*) :: val_str
875 character(len=INPUT_STR_LENGTH) :: strip_quotes
878 strip_quotes = val_str
879 i = index(strip_quotes,achar(34))
881 if (i > 1)
then ; strip_quotes = strip_quotes(:i-1)//strip_quotes(i+1:)
882 else ; strip_quotes = strip_quotes(2:) ;
endif 883 i = index(strip_quotes,achar(34))
885 i = index(strip_quotes,achar(39))
887 if (i > 1)
then ; strip_quotes = strip_quotes(:i-1)//strip_quotes(i+1:)
888 else ; strip_quotes = strip_quotes(2:) ;
endif 889 i = index(strip_quotes,achar(39))
891 end function strip_quotes
896 subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsLogical)
899 character(len=*),
intent(in) :: varname
900 logical,
intent(out) :: found
901 logical,
intent(out) :: defined
902 character(len=*),
intent(out) :: value_string(:)
903 logical,
optional,
intent(in) :: paramIsLogical
907 character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine
908 character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName
909 character(len=FILENAME_LENGTH) :: filename
910 integer :: is, id, isd, isu, ise, iso, verbose, ipf
911 integer :: last, last1, ival, oval, max_vals, count, contBufSize
912 character(len=52) :: set
913 logical :: found_override, found_equals
914 logical :: found_define, found_undef
915 logical :: force_cycle, defined_in_line, continuedLine
916 logical :: variableKindIsLogical, valueIsSame
917 logical :: inWrongBlock, fullPathParameter
918 logical,
parameter :: requireNamedClose = .false.
919 set =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" 920 continuationbuffer = repeat(
" ",input_str_length)
924 variablekindislogical=.false.
925 if (
present(paramislogical)) variablekindislogical = paramislogical
932 max_vals =
SIZE(value_string)
933 do is=1,max_vals ; value_string(is) =
" " ;
enddo 935 paramfile_loop:
do ipf = 1, cs%nfiles
936 filename = cs%filename(ipf)
937 continuedline = .false.
941 do count = 1, cs%param_data(ipf)%num_lines
942 line = cs%param_data(ipf)%line(count)
943 last = len_trim(line)
948 if (line(last1:last1) == achar(92).or.line(last1:last1) ==
"&")
then 949 continuationbuffer(contbufsize+1:contbufsize+len_trim(line))=line(:last-1)
950 contbufsize=contbufsize + len_trim(line)-1
951 continuedline = .true.
952 if (count==cs%param_data(ipf)%num_lines .and. is_root_pe()) &
953 call mom_error(fatal,
"MOM_file_parser : the last line"// &
954 " of the file ends in a continuation character but"// &
955 " there are no more lines to read. "// &
956 " Line: '"//trim(line(:last))//
"'"//&
957 " in file "//trim(filename)//
".")
959 elseif (continuedline)
then 961 continuationbuffer(contbufsize+1:contbufsize+len_trim(line))=line(:last)
962 line = continuationbuffer
963 continuationbuffer=repeat(
" ",input_str_length)
965 continuedline = .false.
966 last = len_trim(line)
969 origline = trim(line)
972 found_override = .false.; found_define = .false.; found_undef = .false.
973 iso = index(line(:last),
"#override " )
974 if (iso>1)
call mom_error(fatal,
"MOM_file_parser : #override was found "// &
975 " but was not the first keyword."// &
976 " Line: '"//trim(line(:last))//
"'"//&
977 " in file "//trim(filename)//
".")
979 found_override = .true.
980 if (index(line(:last),
"#override define ")==1) found_define = .true.
981 if (index(line(:last),
"#override undef ")==1) found_undef = .true.
982 line = trim(adjustl(line(iso+10:last))); last = len_trim(line)
986 if (index(line(:last),
'&')==1)
then 987 iso=index(line(:last),
' ')
989 blockname = pushblocklevel(blockname,line(2:iso-1))
990 line=trim(adjustl(line(iso:last)))
994 if (len_trim(blockname)>0)
then 995 blockname = trim(blockname) //
'%' //trim(line(2:last))
997 blockname = trim(line(2:last))
999 call flag_line_as_read(cs%param_data(ipf)%line_used,count)
1005 iso=index(line(:last),
'%')
1006 fullpathparameter = .false.
1008 if (len_trim(blockname)==0 .and. is_root_pe())
call mom_error(fatal, &
1009 'get_variable_line: An extra close block was encountered. Line="'// &
1010 trim(line(:last))//
'"' )
1011 if (last>1 .and. trim(blockname)/=trim(line(2:last)) .and. is_root_pe()) &
1012 call mom_error(fatal,
'get_variable_line: A named close for a parameter'// &
1013 ' block did not match the open block. Line="'//trim(line(:last))//
'"' )
1014 if (last==1 .and. requirenamedclose) &
1015 call mom_error(fatal,
'get_variable_line: A named close for a parameter'// &
1016 ' block is required but found "%". Block="'//trim(blockname)//
'"' )
1017 blockname = popblocklevel(blockname)
1018 call flag_line_as_read(cs%param_data(ipf)%line_used,count)
1019 elseif (iso==last)
then 1020 blockname = pushblocklevel(blockname, line(:iso-1))
1021 call flag_line_as_read(cs%param_data(ipf)%line_used,count)
1023 iso=index(line(:last),
'%',.true.)
1025 if (iso>0 .and. trim(cs%blockName%name)==trim(line(:iso-1)))
then 1026 fullpathparameter = .true.
1027 line = trim(line(iso+1:last))
1028 last = len_trim(line)
1033 inwrongblock = .false.
1034 if (len_trim(blockname)>0)
then 1035 if (trim(cs%blockName%name)/=trim(blockname)) inwrongblock = .true.
1037 if (len_trim(cs%blockName%name)>0)
then 1038 if (trim(cs%blockName%name)/=trim(blockname)) inwrongblock = .true.
1042 if (line(last:last)==
'/')
then 1043 if (len_trim(blockname)==0 .and. is_root_pe())
call mom_error(fatal, &
1044 'get_variable_line: An extra namelist/block end was encountered. Line="'// &
1045 trim(line(:last))//
'"' )
1046 blockname = popblocklevel(blockname)
1049 if (inwrongblock .and. .not. fullpathparameter)
then 1050 if (index(
" "//line(:last+1),
" "//trim(varname)//
" ")>0) &
1051 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1052 ' found outside of block '//trim(cs%blockName%name)//
'%. Ignoring.')
1057 if (index(
" "//line(:last)//
" ",
" "//trim(varname)//
" ") == 0) cycle
1060 found_equals = .false.
1061 isd = index(line(:last),
"define" )
1062 isu = index(line(:last),
"undef" )
1063 ise = index(line(:last),
" = " );
if (ise > 1) found_equals = .true.
1064 if (index(line(:last),
"#define ")==1) found_define = .true.
1065 if (index(line(:last),
"#undef ")==1) found_undef = .true.
1068 if (is_root_pe())
then 1069 if (.not. (found_define .or. found_undef .or. found_equals)) &
1070 call mom_error(fatal,
"MOM_file_parser : the parameter name '"// &
1071 trim(varname)//
"' was found without define or undef."// &
1072 " Line: '"//trim(line(:last))//
"'"//&
1073 " in file "//trim(filename)//
".")
1074 if (found_define .and. found_undef)
call mom_error(fatal, &
1075 "MOM_file_parser : Both 'undef' and 'define' occur."// &
1076 " Line: '"//trim(line(:last))//
"'"//&
1077 " in file "//trim(filename)//
".")
1078 if (found_equals .and. (found_define .or. found_undef)) &
1079 call mom_error(fatal, &
1080 "MOM_file_parser : Both 'a=b' and 'undef/define' syntax occur."// &
1081 " Line: '"//trim(line(:last))//
"'"//&
1082 " in file "//trim(filename)//
".")
1083 if (found_override .and. .not. (found_define .or. found_undef .or. found_equals)) &
1084 call mom_error(fatal,
"MOM_file_parser : override was found "// &
1085 " without a define or undef."// &
1086 " Line: '"//trim(line(:last))//
"'"//&
1087 " in file "//trim(filename)//
".")
1091 if (found_define)
then 1093 is = isd + 5 + scan(line(isd+6:last), set)
1095 id = scan(line(is:last),
' ')
1098 lname = trim(line(is:last))
1099 if (trim(lname) /= trim(varname)) cycle
1103 lname = trim(line(is:is+id-1))
1104 if (trim(lname) /= trim(varname)) cycle
1105 val_str = trim(adjustl(line(is+id:last)))
1107 found = .true. ; defined_in_line = .true.
1108 elseif (found_undef)
then 1110 is = isu + 4 + scan(line(isu+5:last), set)
1112 id = scan(line(is:last),
' ')
1113 if (id > 0) last = is + id - 1
1114 lname = trim(line(is:last))
1115 if (trim(lname) /= trim(varname)) cycle
1117 found = .true. ; defined_in_line = .false.
1118 elseif (found_equals)
then 1120 is = scan(line(1:ise), set)
1121 lname = trim(line(is:ise-1))
1122 if (trim(lname) /= trim(varname)) cycle
1123 val_str = trim(adjustl(line(ise+3:last)))
1124 if (variablekindislogical)
then 1125 read(val_str(:len_trim(val_str)),*) defined_in_line
1127 defined_in_line = .true.
1131 call mom_error(fatal,
"MOM_file_parser (non-root PE?): the parameter name '"// &
1132 trim(varname)//
"' was found without an assignment, define or undef."// &
1133 " Line: '"//trim(line(:last))//
"'"//
" in file "//trim(filename)//
".")
1137 call flag_line_as_read(cs%param_data(ipf)%line_used,count)
1140 force_cycle = .false.
1141 valueissame = (trim(val_str) == trim(value_string(max_vals)))
1142 if (found_override .and. (oval >= max_vals))
then 1143 if (is_root_pe())
then 1144 if ((defined_in_line .neqv. defined) .or. .not. valueissame)
then 1145 call mom_error(fatal,
"MOM_file_parser : "//trim(varname)// &
1146 " found with multiple inconsistent overrides."// &
1147 " Line A: '"//trim(value_string(max_vals))//
"'"//&
1148 " Line B: '"//trim(line(:last))//
"'"//&
1149 " in file "//trim(filename)//
" caused the model failure.")
1151 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1152 " over-ridden more times than is permitted."// &
1153 " Line: '"//trim(line(:last))//
"'"//&
1154 " in file "//trim(filename)//
" is being ignored.")
1157 force_cycle = .true.
1159 if (.not.found_override .and. (oval > 0))
then 1161 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1162 " has already been over-ridden."// &
1163 " Line: '"//trim(line(:last))//
"'"//&
1164 " in file "//trim(filename)//
" is being ignored.")
1165 force_cycle = .true.
1167 if (.not.found_override .and. (ival >= max_vals))
then 1168 if (is_root_pe())
then 1169 if ((defined_in_line .neqv. defined) .or. .not. valueissame)
then 1170 call mom_error(fatal,
"MOM_file_parser : "//trim(varname)// &
1171 " found with multiple inconsistent definitions."// &
1172 " Line A: '"//trim(value_string(max_vals))//
"'"//&
1173 " Line B: '"//trim(line(:last))//
"'"//&
1174 " in file "//trim(filename)//
" caused the model failure.")
1176 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1177 " occurs more times than is permitted."// &
1178 " Line: '"//trim(line(:last))//
"'"//&
1179 " in file "//trim(filename)//
" is being ignored.")
1182 force_cycle = .true.
1184 if (force_cycle) cycle
1187 if (found_override)
then 1189 value_string(oval) = trim(val_str)
1190 defined = defined_in_line
1191 if (verbose > 0 .and. ival > 0 .and. is_root_pe() .and. &
1192 .not. overridewarninghasbeenissued(cs%chain, trim(varname)) ) &
1193 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1194 " over-ridden. Line: '"//trim(line(:last))//
"'"//&
1195 " in file "//trim(filename)//
".")
1198 value_string(ival) = trim(val_str)
1199 defined = defined_in_line
1200 if (verbose > 1 .and. is_root_pe()) &
1201 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1202 " set. Line: '"//trim(line(:last))//
"'"//&
1203 " in file "//trim(filename)//
".")
1208 if (len_trim(blockname)>0 .and. is_root_pe())
call mom_error(fatal, &
1209 'A namelist/parameter block was not closed. Last open block appears '// &
1210 'to be "'//trim(blockname)//
'".')
1212 enddo paramfile_loop
1214 end subroutine get_variable_line
1217 subroutine flag_line_as_read(line_used, count)
1218 logical,
dimension(:),
pointer :: line_used
1219 integer,
intent(in) :: count
1220 line_used(count) = .true.
1221 end subroutine flag_line_as_read
1224 function overridewarninghasbeenissued(chain, varName)
1227 character(len=*),
intent(in) :: varName
1228 logical :: overrideWarningHasBeenIssued
1230 type(
link_parameter),
pointer :: newLink => null(), this => null()
1232 overridewarninghasbeenissued = .false.
1234 do while(
associated(this) )
1235 if (trim(varname) == trim(this%name))
then 1236 overridewarninghasbeenissued = .true.
1242 newlink%name = trim(varname)
1243 newlink%hasIssuedOverrideWarning = .true.
1244 newlink%next => chain
1246 end function overridewarninghasbeenissued
1252 subroutine log_version_cs(CS, modulename, version, desc, log_to_all, all_default, layout, debugging)
1254 character(len=*),
intent(in) :: modulename
1255 character(len=*),
intent(in) :: version
1256 character(len=*),
optional,
intent(in) :: desc
1257 logical,
optional,
intent(in) :: log_to_all
1260 logical,
optional,
intent(in) :: all_default
1261 logical,
optional,
intent(in) :: layout
1262 logical,
optional,
intent(in) :: debugging
1264 character(len=240) :: mesg
1266 mesg = trim(modulename)//
": "//trim(version)
1267 if (is_root_pe())
then 1268 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1269 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1272 if (
present(desc))
call doc_module(cs%doc, modulename, desc, log_to_all, all_default, layout, debugging)
1274 end subroutine log_version_cs
1277 subroutine log_version_plain(modulename, version)
1278 character(len=*),
intent(in) :: modulename
1279 character(len=*),
intent(in) :: version
1281 character(len=240) :: mesg
1283 mesg = trim(modulename)//
": "//trim(version)
1284 if (is_root_pe())
then 1285 write(stdlog(),
'(a)') trim(mesg)
1288 end subroutine log_version_plain
1291 subroutine log_param_int(CS, modulename, varname, value, desc, units, &
1292 default, layoutParam, debuggingParam, like_default)
1295 character(len=*),
intent(in) :: modulename
1296 character(len=*),
intent(in) :: varname
1297 integer,
intent(in) ::
value 1298 character(len=*),
optional,
intent(in) :: desc
1300 character(len=*),
optional,
intent(in) :: units
1301 integer,
optional,
intent(in) :: default
1302 logical,
optional,
intent(in) :: layoutParam
1304 logical,
optional,
intent(in) :: debuggingParam
1306 logical,
optional,
intent(in) :: like_default
1309 character(len=240) :: mesg, myunits
1311 write(mesg,
'(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(
value))
1312 if (is_root_pe())
then 1313 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1314 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1317 myunits=
" ";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1318 if (
present(desc)) &
1319 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1320 layoutparam=layoutparam, debuggingparam=debuggingparam, like_default=like_default)
1322 end subroutine log_param_int
1325 subroutine log_param_int_array(CS, modulename, varname, value, desc, &
1326 units, default, layoutParam, debuggingParam, like_default)
1329 character(len=*),
intent(in) :: modulename
1330 character(len=*),
intent(in) :: varname
1331 integer,
dimension(:),
intent(in) ::
value 1332 character(len=*),
optional,
intent(in) :: desc
1334 character(len=*),
optional,
intent(in) :: units
1335 integer,
optional,
intent(in) :: default
1336 logical,
optional,
intent(in) :: layoutParam
1338 logical,
optional,
intent(in) :: debuggingParam
1340 logical,
optional,
intent(in) :: like_default
1343 character(len=1320) :: mesg
1344 character(len=240) :: myunits
1346 write(mesg,
'(" ",a," ",a,": ",A)') trim(modulename), trim(varname), trim(left_ints(
value))
1347 if (is_root_pe())
then 1348 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1349 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1352 myunits=
" ";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1353 if (
present(desc)) &
1354 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1355 layoutparam=layoutparam, debuggingparam=debuggingparam, like_default=like_default)
1357 end subroutine log_param_int_array
1360 subroutine log_param_real(CS, modulename, varname, value, desc, units, &
1361 default, debuggingParam, like_default)
1364 character(len=*),
intent(in) :: modulename
1365 character(len=*),
intent(in) :: varname
1366 real,
intent(in) ::
value 1367 character(len=*),
optional,
intent(in) :: desc
1369 character(len=*),
optional,
intent(in) :: units
1370 real,
optional,
intent(in) :: default
1371 logical,
optional,
intent(in) :: debuggingParam
1373 logical,
optional,
intent(in) :: like_default
1376 character(len=240) :: mesg, myunits
1378 write(mesg,
'(" ",a," ",a,": ",a)') &
1379 trim(modulename), trim(varname), trim(left_real(
value))
1380 if (is_root_pe())
then 1381 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1382 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1385 myunits=
"not defined";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1386 if (
present(desc)) &
1387 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1388 debuggingparam=debuggingparam, like_default=like_default)
1390 end subroutine log_param_real
1393 subroutine log_param_real_array(CS, modulename, varname, value, desc, &
1394 units, default, debuggingParam, like_default)
1397 character(len=*),
intent(in) :: modulename
1398 character(len=*),
intent(in) :: varname
1399 real,
dimension(:),
intent(in) ::
value 1400 character(len=*),
optional,
intent(in) :: desc
1402 character(len=*),
optional,
intent(in) :: units
1403 real,
optional,
intent(in) :: default
1404 logical,
optional,
intent(in) :: debuggingParam
1406 logical,
optional,
intent(in) :: like_default
1409 character(len=1320) :: mesg
1410 character(len=240) :: myunits
1415 write(mesg,
'(" ",a," ",a,": ",a)') &
1416 trim(modulename), trim(varname), trim(left_reals(
value))
1417 if (is_root_pe())
then 1418 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1419 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1422 myunits=
"not defined";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1423 if (
present(desc)) &
1424 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1425 debuggingparam=debuggingparam, like_default=like_default)
1427 end subroutine log_param_real_array
1430 subroutine log_param_logical(CS, modulename, varname, value, desc, &
1431 units, default, layoutParam, debuggingParam, like_default)
1434 character(len=*),
intent(in) :: modulename
1435 character(len=*),
intent(in) :: varname
1436 logical,
intent(in) ::
value 1437 character(len=*),
optional,
intent(in) :: desc
1439 character(len=*),
optional,
intent(in) :: units
1440 logical,
optional,
intent(in) :: default
1441 logical,
optional,
intent(in) :: layoutParam
1443 logical,
optional,
intent(in) :: debuggingParam
1445 logical,
optional,
intent(in) :: like_default
1448 character(len=240) :: mesg, myunits
1451 write(mesg,
'(" ",a," ",a,": True")') trim(modulename), trim(varname)
1453 write(mesg,
'(" ",a," ",a,": False")') trim(modulename), trim(varname)
1455 if (is_root_pe())
then 1456 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1457 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1460 myunits=
"Boolean";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1461 if (
present(desc)) &
1462 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1463 layoutparam=layoutparam, debuggingparam=debuggingparam, like_default=like_default)
1465 end subroutine log_param_logical
1468 subroutine log_param_char(CS, modulename, varname, value, desc, units, &
1469 default, layoutParam, debuggingParam, like_default)
1472 character(len=*),
intent(in) :: modulename
1473 character(len=*),
intent(in) :: varname
1474 character(len=*),
intent(in) ::
value 1475 character(len=*),
optional,
intent(in) :: desc
1477 character(len=*),
optional,
intent(in) :: units
1478 character(len=*),
optional,
intent(in) :: default
1479 logical,
optional,
intent(in) :: layoutParam
1481 logical,
optional,
intent(in) :: debuggingParam
1483 logical,
optional,
intent(in) :: like_default
1486 character(len=1024) :: mesg, myunits
1488 write(mesg,
'(" ",a," ",a,": ",a)') &
1489 trim(modulename), trim(varname), trim(
value)
1490 if (is_root_pe())
then 1491 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1492 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1495 myunits=
" ";
if (
present(units))
write(myunits(1:1024),
'(A)') trim(units)
1496 if (
present(desc)) &
1497 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1498 layoutparam=layoutparam, debuggingparam=debuggingparam, like_default=like_default)
1500 end subroutine log_param_char
1504 subroutine log_param_time(CS, modulename, varname, value, desc, units, &
1505 default, timeunit, layoutParam, debuggingParam, log_date, like_default)
1508 character(len=*),
intent(in) :: modulename
1509 character(len=*),
intent(in) :: varname
1510 type(time_type),
intent(in) ::
value 1511 character(len=*),
optional,
intent(in) :: desc
1513 character(len=*),
optional,
intent(in) :: units
1514 type(time_type),
optional,
intent(in) :: default
1515 real,
optional,
intent(in) :: timeunit
1517 logical,
optional,
intent(in) :: log_date
1519 logical,
optional,
intent(in) :: layoutParam
1521 logical,
optional,
intent(in) :: debuggingParam
1523 logical,
optional,
intent(in) :: like_default
1527 real :: real_time, real_default
1528 logical :: use_timeunit, date_format
1529 character(len=240) :: mesg, myunits
1530 character(len=80) :: date_string, default_string
1531 integer :: days, secs, ticks, ticks_per_sec
1533 use_timeunit = .false.
1534 date_format = .false. ;
if (
present(log_date)) date_format = log_date
1536 call get_time(
value, secs, days, ticks)
1538 if (ticks == 0)
then 1539 write(mesg,
'(" ",a," ",a," (Time): ",i0,":",i0)') trim(modulename), &
1540 trim(varname), days, secs
1542 write(mesg,
'(" ",a," ",a," (Time): ",i0,":",i0,":",i0)') trim(modulename), &
1543 trim(varname), days, secs, ticks
1545 if (is_root_pe())
then 1546 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1547 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1550 if (
present(desc))
then 1551 if (
present(timeunit)) use_timeunit = (timeunit > 0.0)
1552 if (date_format)
then 1555 date_string = convert_date_to_string(
value)
1556 if (
present(default))
then 1557 default_string = convert_date_to_string(default)
1558 call doc_param(cs%doc, varname, desc, myunits, date_string, &
1559 default=default_string, layoutparam=layoutparam, &
1560 debuggingparam=debuggingparam, like_default=like_default)
1562 call doc_param(cs%doc, varname, desc, myunits, date_string, &
1563 layoutparam=layoutparam, debuggingparam=debuggingparam, like_default=like_default)
1565 elseif (use_timeunit)
then 1566 if (
present(units))
then 1567 write(myunits(1:240),
'(A)') trim(units)
1569 if (abs(timeunit-1.0) < 0.01)
then ; myunits =
"seconds" 1570 elseif (abs(timeunit-3600.0) < 1.0)
then ; myunits =
"hours" 1571 elseif (abs(timeunit-86400.0) < 1.0)
then ; myunits =
"days" 1572 elseif (abs(timeunit-3.1e7) < 1.0e6)
then ; myunits =
"years" 1573 else ;
write(myunits,
'(es8.2," sec")') timeunit ;
endif 1575 real_time = (86400.0/timeunit)*days + secs/timeunit
1576 if (ticks > 0) real_time = real_time + &
1577 real(ticks) / (timeunit*get_ticks_per_second())
1578 if (
present(default))
then 1579 call get_time(default, secs, days, ticks)
1580 real_default = (86400.0/timeunit)*days + secs/timeunit
1581 if (ticks > 0) real_default = real_default + &
1582 real(ticks) / (timeunit*get_ticks_per_second())
1583 call doc_param(cs%doc, varname, desc, myunits, real_time, real_default, like_default=like_default)
1585 call doc_param(cs%doc, varname, desc, myunits, real_time, like_default=like_default)
1588 call doc_param(cs%doc, varname, desc,
value, default, units=units, like_default=like_default)
1592 end subroutine log_param_time
1595 function convert_date_to_string(date)
result(date_string)
1596 type(time_type),
intent(in) :: date
1597 character(len=40) :: date_string
1600 character(len=40) :: sub_string
1602 integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec
1604 call get_date(date, yrs, mons, days, hours, mins, secs, ticks)
1605 write (date_string,
'(i8.4)') yrs
1606 write (sub_string,
'("-", i2.2, "-", I2.2, " ", i2.2, ":", i2.2, ":")') &
1607 mons, days, hours, mins
1608 date_string = trim(adjustl(date_string)) // trim(sub_string)
1610 ticks_per_sec = get_ticks_per_second()
1611 real_secs = secs + ticks/ticks_per_sec
1612 if (ticks_per_sec <= 100)
then 1613 write (sub_string,
'(F7.3)') real_secs
1615 write (sub_string,
'(F10.6)') real_secs
1618 write (sub_string,
'(i2.2)') secs
1620 date_string = trim(date_string) // trim(adjustl(sub_string))
1622 end function convert_date_to_string
1626 subroutine get_param_int(CS, modulename, varname, value, desc, units, &
1627 default, fail_if_missing, do_not_read, do_not_log, &
1628 static_value, layoutParam, debuggingParam)
1631 character(len=*),
intent(in) :: modulename
1632 character(len=*),
intent(in) :: varname
1633 integer,
intent(inout) ::
value 1635 character(len=*),
optional,
intent(in) :: desc
1637 character(len=*),
optional,
intent(in) :: units
1638 integer,
optional,
intent(in) :: default
1639 integer,
optional,
intent(in) :: static_value
1642 logical,
optional,
intent(in) :: fail_if_missing
1644 logical,
optional,
intent(in) :: do_not_read
1646 logical,
optional,
intent(in) :: do_not_log
1648 logical,
optional,
intent(in) :: layoutParam
1650 logical,
optional,
intent(in) :: debuggingParam
1653 logical :: do_read, do_log
1655 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1656 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1659 if (
present(default))
value = default
1660 if (
present(static_value))
value = static_value
1661 call read_param_int(cs, varname,
value, fail_if_missing)
1665 call log_param_int(cs, modulename, varname,
value, desc, units, &
1666 default, layoutparam, debuggingparam)
1669 end subroutine get_param_int
1673 subroutine get_param_int_array(CS, modulename, varname, value, desc, units, &
1674 default, fail_if_missing, do_not_read, do_not_log, &
1675 static_value, layoutParam, debuggingParam)
1678 character(len=*),
intent(in) :: modulename
1679 character(len=*),
intent(in) :: varname
1680 integer,
dimension(:),
intent(inout) ::
value 1682 character(len=*),
optional,
intent(in) :: desc
1684 character(len=*),
optional,
intent(in) :: units
1685 integer,
optional,
intent(in) :: default
1686 integer,
optional,
intent(in) :: static_value
1689 logical,
optional,
intent(in) :: fail_if_missing
1691 logical,
optional,
intent(in) :: do_not_read
1693 logical,
optional,
intent(in) :: do_not_log
1695 logical,
optional,
intent(in) :: layoutParam
1697 logical,
optional,
intent(in) :: debuggingParam
1700 logical :: do_read, do_log
1702 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1703 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1706 if (
present(default))
then ; value(:) = default ;
endif 1707 if (
present(static_value))
then ; value(:) = static_value ;
endif 1708 call read_param_int_array(cs, varname,
value, fail_if_missing)
1712 call log_param_int_array(cs, modulename, varname,
value, desc, &
1713 units, default, layoutparam, debuggingparam)
1716 end subroutine get_param_int_array
1720 subroutine get_param_real(CS, modulename, varname, value, desc, units, &
1721 default, fail_if_missing, do_not_read, do_not_log, &
1722 static_value, debuggingParam, scale, unscaled)
1725 character(len=*),
intent(in) :: modulename
1726 character(len=*),
intent(in) :: varname
1727 real,
intent(inout) ::
value 1729 character(len=*),
optional,
intent(in) :: desc
1731 character(len=*),
optional,
intent(in) :: units
1732 real,
optional,
intent(in) :: default
1733 real,
optional,
intent(in) :: static_value
1736 logical,
optional,
intent(in) :: fail_if_missing
1738 logical,
optional,
intent(in) :: do_not_read
1740 logical,
optional,
intent(in) :: do_not_log
1742 logical,
optional,
intent(in) :: debuggingParam
1744 real,
optional,
intent(in) :: scale
1746 real,
optional,
intent(out) :: unscaled
1749 logical :: do_read, do_log
1751 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1752 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1755 if (
present(default))
value = default
1756 if (
present(static_value))
value = static_value
1757 call read_param_real(cs, varname,
value, fail_if_missing)
1761 call log_param_real(cs, modulename, varname,
value, desc, units, &
1762 default, debuggingparam)
1765 if (
present(unscaled)) unscaled =
value 1766 if (
present(scale))
value = scale*
value 1768 end subroutine get_param_real
1772 subroutine get_param_real_array(CS, modulename, varname, value, desc, units, &
1773 default, fail_if_missing, do_not_read, do_not_log, debuggingParam, &
1774 static_value, scale, unscaled)
1777 character(len=*),
intent(in) :: modulename
1778 character(len=*),
intent(in) :: varname
1779 real,
dimension(:),
intent(inout) ::
value 1781 character(len=*),
optional,
intent(in) :: desc
1783 character(len=*),
optional,
intent(in) :: units
1784 real,
optional,
intent(in) :: default
1785 real,
optional,
intent(in) :: static_value
1788 logical,
optional,
intent(in) :: fail_if_missing
1790 logical,
optional,
intent(in) :: do_not_read
1792 logical,
optional,
intent(in) :: do_not_log
1794 logical,
optional,
intent(in) :: debuggingParam
1796 real,
optional,
intent(in) :: scale
1798 real,
dimension(:),
optional,
intent(out) :: unscaled
1801 logical :: do_read, do_log
1803 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1804 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1807 if (
present(default))
then ; value(:) = default ;
endif 1808 if (
present(static_value))
then ; value(:) = static_value ;
endif 1809 call read_param_real_array(cs, varname,
value, fail_if_missing)
1813 call log_param_real_array(cs, modulename, varname,
value, desc, &
1814 units, default, debuggingparam)
1817 if (
present(unscaled)) unscaled(:) = value(:)
1818 if (
present(scale)) value(:) = scale*value(:)
1820 end subroutine get_param_real_array
1824 subroutine get_param_char(CS, modulename, varname, value, desc, units, &
1825 default, fail_if_missing, do_not_read, do_not_log, &
1826 static_value, layoutParam, debuggingParam)
1829 character(len=*),
intent(in) :: modulename
1830 character(len=*),
intent(in) :: varname
1831 character(len=*),
intent(inout) ::
value 1833 character(len=*),
optional,
intent(in) :: desc
1835 character(len=*),
optional,
intent(in) :: units
1836 character(len=*),
optional,
intent(in) :: default
1837 character(len=*),
optional,
intent(in) :: static_value
1840 logical,
optional,
intent(in) :: fail_if_missing
1842 logical,
optional,
intent(in) :: do_not_read
1844 logical,
optional,
intent(in) :: do_not_log
1846 logical,
optional,
intent(in) :: layoutParam
1848 logical,
optional,
intent(in) :: debuggingParam
1851 logical :: do_read, do_log
1853 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1854 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1857 if (
present(default))
value = default
1858 if (
present(static_value))
value = static_value
1859 call read_param_char(cs, varname,
value, fail_if_missing)
1863 call log_param_char(cs, modulename, varname,
value, desc, units, &
1864 default, layoutparam, debuggingparam)
1867 end subroutine get_param_char
1871 subroutine get_param_char_array(CS, modulename, varname, value, desc, units, &
1872 default, fail_if_missing, do_not_read, do_not_log, static_value)
1875 character(len=*),
intent(in) :: modulename
1876 character(len=*),
intent(in) :: varname
1877 character(len=*),
dimension(:),
intent(inout) ::
value 1879 character(len=*),
optional,
intent(in) :: desc
1881 character(len=*),
optional,
intent(in) :: units
1882 character(len=*),
optional,
intent(in) :: default
1883 character(len=*),
optional,
intent(in) :: static_value
1886 logical,
optional,
intent(in) :: fail_if_missing
1888 logical,
optional,
intent(in) :: do_not_read
1890 logical,
optional,
intent(in) :: do_not_log
1894 logical :: do_read, do_log
1895 integer :: i, len_tot, len_val
1896 character(len=1024) :: cat_val
1898 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1899 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1902 if (
present(default))
then ; value(:) = default ;
endif 1903 if (
present(static_value))
then ; value(:) = static_value ;
endif 1904 call read_param_char_array(cs, varname,
value, fail_if_missing)
1908 cat_val = trim(value(1)); len_tot = len_trim(value(1))
1910 len_val = len_trim(value(i))
1911 if ((len_val > 0) .and. (len_tot + len_val + 2 < 240))
then 1912 cat_val = trim(cat_val)//achar(34)//
", "//achar(34)//trim(value(i))
1913 len_tot = len_tot + len_val
1916 call log_param_char(cs, modulename, varname, cat_val, desc, &
1920 end subroutine get_param_char_array
1924 subroutine get_param_logical(CS, modulename, varname, value, desc, units, &
1925 default, fail_if_missing, do_not_read, do_not_log, &
1926 static_value, layoutParam, debuggingParam)
1929 character(len=*),
intent(in) :: modulename
1930 character(len=*),
intent(in) :: varname
1931 logical,
intent(inout) ::
value 1933 character(len=*),
optional,
intent(in) :: desc
1935 character(len=*),
optional,
intent(in) :: units
1936 logical,
optional,
intent(in) :: default
1937 logical,
optional,
intent(in) :: static_value
1940 logical,
optional,
intent(in) :: fail_if_missing
1942 logical,
optional,
intent(in) :: do_not_read
1944 logical,
optional,
intent(in) :: do_not_log
1946 logical,
optional,
intent(in) :: layoutParam
1948 logical,
optional,
intent(in) :: debuggingParam
1951 logical :: do_read, do_log
1953 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1954 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1957 if (
present(default))
value = default
1958 if (
present(static_value))
value = static_value
1959 call read_param_logical(cs, varname,
value, fail_if_missing)
1963 call log_param_logical(cs, modulename, varname,
value, desc, &
1964 units, default, layoutparam, debuggingparam)
1967 end subroutine get_param_logical
1971 subroutine get_param_time(CS, modulename, varname, value, desc, units, &
1972 default, fail_if_missing, do_not_read, do_not_log, &
1973 timeunit, static_value, layoutParam, debuggingParam, &
1977 character(len=*),
intent(in) :: modulename
1978 character(len=*),
intent(in) :: varname
1979 type(time_type),
intent(inout) ::
value 1981 character(len=*),
optional,
intent(in) :: desc
1983 character(len=*),
optional,
intent(in) :: units
1984 type(time_type),
optional,
intent(in) :: default
1985 type(time_type),
optional,
intent(in) :: static_value
1988 logical,
optional,
intent(in) :: fail_if_missing
1990 logical,
optional,
intent(in) :: do_not_read
1992 logical,
optional,
intent(in) :: do_not_log
1994 real,
optional,
intent(in) :: timeunit
1996 logical,
optional,
intent(in) :: layoutParam
1998 logical,
optional,
intent(in) :: debuggingParam
2000 logical,
optional,
intent(in) :: log_as_date
2003 logical :: do_read, do_log, date_format, log_date
2005 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
2006 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
2010 if (
present(default))
value = default
2011 if (
present(static_value))
value = static_value
2012 call read_param_time(cs, varname,
value, timeunit, fail_if_missing, date_format=log_date)
2016 if (
present(log_as_date)) log_date = log_as_date
2017 call log_param_time(cs, modulename, varname,
value, desc, units, default, &
2018 timeunit, layoutparam=layoutparam, &
2019 debuggingparam=debuggingparam, log_date=log_date)
2022 end subroutine get_param_time
2027 subroutine clearparameterblock(CS)
2032 if (
associated(cs%blockName))
then 2033 block => cs%blockName
2036 if (is_root_pe())
call mom_error(fatal, &
2037 'clearParameterBlock: A clear was attempted before allocation.')
2039 end subroutine clearparameterblock
2042 subroutine openparameterblock(CS,blockName,desc)
2045 character(len=*),
intent(in) :: blockName
2046 character(len=*),
optional,
intent(in) :: desc
2049 if (
associated(cs%blockName))
then 2050 block => cs%blockName
2051 block%name = pushblocklevel(block%name,blockname)
2052 call doc_openblock(cs%doc,block%name,desc)
2054 if (is_root_pe())
call mom_error(fatal, &
2055 'openParameterBlock: A push was attempted before allocation.')
2057 end subroutine openparameterblock
2060 subroutine closeparameterblock(CS)
2066 if (
associated(cs%blockName))
then 2067 block => cs%blockName
2068 if (is_root_pe().and.len_trim(block%name)==0)
call mom_error(fatal, &
2069 'closeParameterBlock: A pop was attempted on an empty stack. ("'//&
2070 trim(block%name)//
'")')
2071 call doc_closeblock(cs%doc,block%name)
2073 if (is_root_pe())
call mom_error(fatal, &
2074 'closeParameterBlock: A pop was attempted before allocation.')
2076 block%name = popblocklevel(block%name)
2077 end subroutine closeparameterblock
2080 function pushblocklevel(oldblockName,newBlockName)
2081 character(len=*),
intent(in) :: oldBlockName
2082 character(len=*),
intent(in) :: newBlockName
2083 character(len=len(oldBlockName)+40) :: pushBlockLevel
2085 if (len_trim(oldblockname)>0)
then 2086 pushblocklevel=trim(oldblockname)//
'%'//trim(newblockname)
2088 pushblocklevel=trim(newblockname)
2090 end function pushblocklevel
2093 function popblocklevel(oldblockName)
2094 character(len=*),
intent(in) :: oldBlockName
2095 character(len=len(oldBlockName)+40) :: popBlockLevel
2098 i = index(trim(oldblockname),
'%', .true.)
2100 popblocklevel = trim(oldblockname(1:i-1))
2104 if (is_root_pe())
call mom_error(fatal, &
2105 'popBlockLevel: A pop was attempted leaving an empty block name.')
2107 end function popblocklevel
Wraps the FMS time manager functions.
The subroutines here provide hooks for document generation functions at various levels of granularity...
A structure that can be parsed to read and document run-time parameters.
A link in the list of variables that have already had override warnings issued.
The MOM6 facility to parse input files for runtime parameters.
An overloaded interface to log the values of various types of parameters.
Interfaces to non-domain-oriented communication subroutines, including the MOM6 reproducing sums faci...
Document parameter values.
Routines for error handling and I/O management.
Specify the active parameter block.
An overloaded interface to log version information about modules.
An overloaded interface to read various types of parameters.
A structure that controls where the documentation occurs, its veborsity and formatting.
Handy functions for manipulating strings.
The valid lines extracted from an input parameter file without comments.
An overloaded interface to read and log the values of various types of parameters.