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