6 use mom_coms,
only : root_pe, broadcast
16 implicit none ;
private
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 =
''
70 logical :: log_open = .false.
73 character(len=240) :: doc_file
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.")
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)
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
224 call read_param(cs,
"COMPLETE_DOCUMENTATION", cs%complete_doc)
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)
244 logical,
optional,
intent(in) :: quiet_close
246 character(len=*),
optional,
intent(in) :: component
249 character(len=128) :: docfile_default
250 character(len=40) :: mdl
252 # include "version_variable.h"
253 integer :: i, n, num_unused
255 if (
present(quiet_close))
then ;
if (quiet_close)
then
258 call mom_mesg(
"close_param_file: "// trim(cs%filename(i))// &
259 " has been closed successfully.", 5)
262 cs%NetCDF_file(i) = .false.
263 deallocate (cs%param_data(i)%line)
264 deallocate (cs%param_data(i)%line_used)
266 cs%log_open = .false.
272 mdl =
"MOM_file_parser"
274 call log_param(cs, mdl,
"SEND_LOG_TO_STDOUT", cs%log_to_stdout, &
275 "If true, all log messages are also sent to stdout.", &
277 call log_param(cs, mdl,
"REPORT_UNUSED_PARAMS", cs%report_unused, &
278 "If true, report any parameter lines that are not used "//&
280 debuggingparam=.true.)
281 call log_param(cs, mdl,
"FATAL_UNUSED_PARAMS", cs%unused_params_fatal, &
282 "If true, kill the run if there are any unused "//&
284 debuggingparam=.true.)
285 docfile_default =
"MOM_parameter_doc"
286 if (
present(component)) docfile_default = trim(component)//
"_parameter_doc"
287 call log_param(cs, mdl,
"DOCUMENT_FILE", cs%doc_file, &
288 "The basename for files where run-time parameters, their "//&
289 "settings, units and defaults are documented. Blank will "//&
290 "disable all parameter documentation.", default=docfile_default)
291 if (len_trim(cs%doc_file) > 0)
then
292 call log_param(cs, mdl,
"COMPLETE_DOCUMENTATION", cs%complete_doc, &
293 "If true, all run-time parameters are "//&
294 "documented in "//trim(cs%doc_file)//&
296 call log_param(cs, mdl,
"MINIMAL_DOCUMENTATION", cs%minimal_doc, &
297 "If true, non-default run-time parameters are "//&
298 "documented in "//trim(cs%doc_file)//&
304 if (
is_root_pe() .and. (cs%report_unused .or. &
305 cs%unused_params_fatal))
then
307 do n=1,cs%param_data(i)%num_lines
308 if (.not.cs%param_data(i)%line_used(n))
then
309 num_unused = num_unused + 1
310 if (cs%report_unused) &
311 call mom_error(warning,
"Unused line in "//trim(cs%filename(i))// &
312 " : "//trim(cs%param_data(i)%line(n)))
318 call mom_mesg(
"close_param_file: "// trim(cs%filename(i))// &
319 " has been closed successfully.", 5)
322 cs%NetCDF_file(i) = .false.
323 deallocate (cs%param_data(i)%line)
324 deallocate (cs%param_data(i)%line_used)
327 if (
is_root_pe() .and. (num_unused>0) .and. cs%unused_params_fatal) &
328 call mom_error(fatal,
"Run stopped because of unused parameter lines.")
330 cs%log_open = .false.
338 integer,
intent(in) :: iounit
339 character(len=*),
intent(in) :: filename
344 character(len=INPUT_STR_LENGTH) :: line
346 logical :: inMultiLineComment
352 if (iounit <= 0)
return
360 inmultilinecomment = .false.
362 read(iounit,
'(a)',
end=8, err=9) line
364 if (inmultilinecomment)
then
374 call mom_error(fatal,
'MOM_file_parser : A C-style multi-line comment '// &
375 '(/* ... */) was not closed before the end of '//trim(filename))
378 param_data%num_lines = num_lines
383 call broadcast(param_data%num_lines, root_pe())
387 num_lines = param_data%num_lines
388 allocate (param_data%line(num_lines))
389 allocate (param_data%line_used(num_lines))
390 param_data%line(:) =
' '
391 param_data%line_used(:) = .false.
401 read(iounit,
'(a)',
end=18, err=9) line
403 if (inmultilinecomment)
then
409 num_lines = num_lines + 1
410 param_data%line(num_lines) = line
417 if (num_lines /= param_data%num_lines) &
418 call mom_error(fatal,
'MOM_file_parser : Found different number of '// &
419 'valid lines on second reading of '//trim(filename))
429 9
call mom_error(fatal,
"MOM_file_parser : "//&
430 "Error while reading file "//trim(filename))
437 character(len=*),
intent(in) :: string
441 integer :: icom, last
445 icom = index(string(last:),
"/*")
455 character(len=*),
intent(in) :: string
465 character(len=*),
intent(in) :: string
469 integer :: icom, last
472 last = len_trim(string)
473 icom = index(string(:last),
"!") ;
if (icom > 0) last = icom-1
474 icom = index(string(:last),
"//") ;
if (icom > 0) last = icom-1
475 icom = index(string(:last),
"/*") ;
if (icom > 0) last = icom-1
481 character(len=*),
intent(in) :: string
489 character(len=*),
intent(in) :: string
495 if (string(i:i)==achar(9))
then
505 character(len=*),
intent(in) :: string
518 character(len=*),
intent(in) :: string
523 logical :: nonblank = .false., insidestring = .false.
524 character(len=1) :: quotechar=
" "
526 nonblank = .false.; insidestring = .false.
529 do j=1,len_trim(string)
530 if (insidestring)
then
533 if (string(j:j)==quotechar) insidestring=.false.
535 if (string(j:j)==
" " .or. string(j:j)==achar(9))
then
541 elseif (string(j:j)==
'"' .or. string(j:j)==
"'")
then
545 quotechar=string(j:j)
547 elseif (string(j:j)==
'=')
then
563 if (insidestring)
then
564 if (is_root_pe())
call mom_error(fatal, &
565 "There is a mismatched quote in the parameter file line: "// &
574 character(len=*),
intent(in) :: varname
575 integer,
intent(inout) ::
value
577 logical,
optional,
intent(in) :: fail_if_missing
580 character(len=INPUT_STR_LENGTH) :: value_string(1)
581 logical :: found, defined
584 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then
585 read(value_string(1),*,err = 1001)
value
587 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
589 call mom_error(fatal,
'read_param_int: Unable to find variable '//trim(varname)// &
590 ' in any input files.')
592 call mom_error(fatal,
'read_param_int: Variable '//trim(varname)// &
593 ' found but not set in input files.')
598 1001
call mom_error(fatal,
'read_param_int: read error for integer variable '//trim(varname)// &
599 ' parsing "'//trim(value_string(1))//
'"')
606 character(len=*),
intent(in) :: varname
607 integer,
dimension(:),
intent(inout) ::
value
609 logical,
optional,
intent(in) :: fail_if_missing
612 character(len=INPUT_STR_LENGTH) :: value_string(1)
613 logical :: found, defined
616 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then
617 read(value_string(1),*,
end=991,err=1002) value
620 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
622 call mom_error(fatal,
'read_param_int_array: Unable to find variable '//trim(varname)// &
623 ' in any input files.')
625 call mom_error(fatal,
'read_param_int_array: Variable '//trim(varname)// &
626 ' found but not set in input files.')
631 1002
call mom_error(fatal,
'read_param_int_array: read error for integer array '//trim(varname)// &
632 ' parsing "'//trim(value_string(1))//
'"')
639 character(len=*),
intent(in) :: varname
640 real,
intent(inout) ::
value
642 logical,
optional,
intent(in) :: fail_if_missing
644 real,
optional,
intent(in) :: scale
648 character(len=INPUT_STR_LENGTH) :: value_string(1)
649 logical :: found, defined
652 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then
653 read(value_string(1),*,err=1003)
value
654 if (
present(scale))
value = scale*
value
656 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
658 call mom_error(fatal,
'read_param_real: Unable to find variable '//trim(varname)// &
659 ' in any input files.')
661 call mom_error(fatal,
'read_param_real: Variable '//trim(varname)// &
662 ' found but not set in input files.')
667 1003
call mom_error(fatal,
'read_param_real: read error for real variable '//trim(varname)// &
668 ' parsing "'//trim(value_string(1))//
'"')
675 character(len=*),
intent(in) :: varname
676 real,
dimension(:),
intent(inout) ::
value
678 logical,
optional,
intent(in) :: fail_if_missing
680 real,
optional,
intent(in) :: scale
684 character(len=INPUT_STR_LENGTH) :: value_string(1)
685 logical :: found, defined
688 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then
689 read(value_string(1),*,
end=991,err=1004) value
691 if (
present(scale)) value(:) = scale*value(:)
694 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
696 call mom_error(fatal,
'read_param_real_array: Unable to find variable '//trim(varname)// &
697 ' in any input files.')
699 call mom_error(fatal,
'read_param_real_array: Variable '//trim(varname)// &
700 ' found but not set in input files.')
705 1004
call mom_error(fatal,
'read_param_real_array: read error for real array '//trim(varname)// &
706 ' parsing "'//trim(value_string(1))//
'"')
713 character(len=*),
intent(in) :: varname
714 character(len=*),
intent(inout) ::
value
716 logical,
optional,
intent(in) :: fail_if_missing
719 character(len=INPUT_STR_LENGTH) :: value_string(1)
720 logical :: found, defined
725 elseif (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
726 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
727 ' in any input files.')
736 character(len=*),
intent(in) :: varname
737 character(len=*),
dimension(:),
intent(inout) ::
value
739 logical,
optional,
intent(in) :: fail_if_missing
743 character(len=INPUT_STR_LENGTH) :: value_string(1), loc_string
744 logical :: found, defined
749 loc_string = trim(value_string(1))
750 i = index(loc_string,
",")
755 loc_string = trim(adjustl(loc_string(i+1:)))
756 i = index(loc_string,
",")
758 if (len_trim(loc_string)>0)
then
762 do i=i_out,
SIZE(
value) ; value(i) =
" " ;
enddo
763 elseif (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
764 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
765 ' in any input files.')
774 character(len=*),
intent(in) :: varname
775 logical,
intent(inout) ::
value
777 logical,
optional,
intent(in) :: fail_if_missing
781 character(len=INPUT_STR_LENGTH) :: value_string(1)
782 logical :: found, defined
784 call get_variable_line(cs, varname, found, defined, value_string, paramislogical=.true.)
787 elseif (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
788 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
789 ' in any input files.')
794 subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format)
797 character(len=*),
intent(in) :: varname
798 type(time_type),
intent(inout) ::
value
800 real,
optional,
intent(in) :: timeunit
801 logical,
optional,
intent(in) :: fail_if_missing
803 logical,
optional,
intent(out) :: date_format
808 character(len=INPUT_STR_LENGTH) :: value_string(1)
809 character(len=240) :: err_msg
810 logical :: found, defined
811 real :: real_time, time_unit
814 if (
present(date_format)) date_format = .false.
817 if (found .and. defined .and. (len_trim(value_string(1)) > 0))
then
820 if ((index(value_string(1),
'-') > 0) .and. &
821 (index(value_string(1),
'-',back=.true.) > index(value_string(1),
'-')))
then
823 value = set_date(value_string(1), err_msg=err_msg)
824 if (len_trim(err_msg) > 0)
call mom_error(fatal,
'read_param_time: '//&
825 trim(err_msg)//
' in integer list read error for time-type variable '//&
826 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
827 if (
present(date_format)) date_format = .true.
828 elseif (index(value_string(1),
',') > 0)
then
830 vals(:) = (/ -999, -999, -999, 0, 0, 0, 0 /)
831 read(value_string(1),*,
end=995,err=1005) vals
833 if ((vals(1) < 0) .or. (vals(2) < 0) .or. (vals(3) < 0)) &
834 call mom_error(fatal,
'read_param_time: integer list read error for time-type variable '//&
835 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
836 value = set_date(vals(1), vals(2), vals(3), vals(4), vals(5), vals(6), &
837 vals(7), err_msg=err_msg)
838 if (len_trim(err_msg) > 0)
call mom_error(fatal,
'read_param_time: '//&
839 trim(err_msg)//
' in integer list read error for time-type variable '//&
840 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
841 if (
present(date_format)) date_format = .true.
843 time_unit = 1.0 ;
if (
present(timeunit)) time_unit = timeunit
844 read( value_string(1), *) real_time
845 value = real_to_time(real_time*time_unit)
848 if (
present(fail_if_missing))
then ;
if (fail_if_missing)
then
850 call mom_error(fatal,
'Unable to find variable '//trim(varname)// &
851 ' in any input files.')
853 call mom_error(fatal,
'Variable '//trim(varname)// &
854 ' found but not set in input files.')
859 1005
call mom_error(fatal,
'read_param_time: read error for time-type variable '//&
860 trim(varname)//
' parsing "'//trim(value_string(1))//
'"')
865 character(len=*) :: val_str
887 subroutine get_variable_line(CS, varname, found, defined, value_string, paramIsLogical)
890 character(len=*),
intent(in) :: varname
891 logical,
intent(out) :: found
892 logical,
intent(out) :: defined
893 character(len=*),
intent(out) :: value_string(:)
894 logical,
optional,
intent(in) :: paramIsLogical
898 character(len=INPUT_STR_LENGTH) :: val_str, lname, origLine
899 character(len=INPUT_STR_LENGTH) :: line, continuationBuffer, blockName
900 character(len=FILENAME_LENGTH) :: filename
901 integer :: is, id, isd, isu, ise, iso, verbose, ipf
902 integer :: last, last1, ival, oval, max_vals, count, contBufSize
903 character(len=52) :: set
904 logical :: found_override, found_equals
905 logical :: found_define, found_undef
906 logical :: force_cycle, defined_in_line, continuedLine
907 logical :: variableKindIsLogical, valueIsSame
908 logical :: inWrongBlock, fullPathParameter
909 logical,
parameter :: requireNamedClose = .false.
910 set =
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
915 variablekindislogical=.false.
916 if (
present(paramislogical)) variablekindislogical = paramislogical
923 max_vals =
SIZE(value_string)
924 do is=1,max_vals ; value_string(is) =
" " ;
enddo
926 paramfile_loop:
do ipf = 1, cs%nfiles
927 filename = cs%filename(ipf)
928 continuedline = .false.
932 do count = 1, cs%param_data(ipf)%num_lines
933 line = cs%param_data(ipf)%line(count)
934 last = len_trim(line)
939 if (line(last1:last1) == achar(92).or.line(last1:last1) ==
"&")
then
940 continuationbuffer(contbufsize+1:contbufsize+len_trim(line))=line(:last-1)
941 contbufsize=contbufsize + len_trim(line)-1
942 continuedline = .true.
943 if (count==cs%param_data(ipf)%num_lines .and. is_root_pe()) &
944 call mom_error(fatal,
"MOM_file_parser : the last line"// &
945 " of the file ends in a continuation character but"// &
946 " there are no more lines to read. "// &
947 " Line: '"//trim(line(:last))//
"'"//&
948 " in file "//trim(filename)//
".")
950 elseif (continuedline)
then
952 continuationbuffer(contbufsize+1:contbufsize+len_trim(line))=line(:last)
953 line = continuationbuffer
956 continuedline = .false.
957 last = len_trim(line)
960 origline = trim(line)
963 found_override = .false.; found_define = .false.; found_undef = .false.
964 iso = index(line(:last),
"#override " )
965 if (iso>1)
call mom_error(fatal,
"MOM_file_parser : #override was found "// &
966 " but was not the first keyword."// &
967 " Line: '"//trim(line(:last))//
"'"//&
968 " in file "//trim(filename)//
".")
970 found_override = .true.
971 if (index(line(:last),
"#override define ")==1) found_define = .true.
972 if (index(line(:last),
"#override undef ")==1) found_undef = .true.
973 line = trim(adjustl(line(iso+10:last))); last = len_trim(line)
977 if (index(line(:last),
'&')==1)
then
978 iso=index(line(:last),
' ')
981 line=trim(adjustl(line(iso:last)))
985 if (len_trim(blockname)>0)
then
986 blockname = trim(blockname) //
'%' //trim(line(2:last))
988 blockname = trim(line(2:last))
996 iso=index(line(:last),
'%')
997 fullpathparameter = .false.
999 if (len_trim(blockname)==0 .and. is_root_pe())
call mom_error(fatal, &
1000 'get_variable_line: An extra close block was encountered. Line="'// &
1001 trim(line(:last))//
'"' )
1002 if (last>1 .and. trim(blockname)/=trim(line(2:last)) .and. is_root_pe()) &
1003 call mom_error(fatal,
'get_variable_line: A named close for a parameter'// &
1004 ' block did not match the open block. Line="'//trim(line(:last))//
'"' )
1005 if (last==1 .and. requirenamedclose) &
1006 call mom_error(fatal,
'get_variable_line: A named close for a parameter'// &
1007 ' block is required but found "%". Block="'//trim(blockname)//
'"' )
1010 elseif (iso==last)
then
1014 iso=index(line(:last),
'%',.true.)
1016 if (iso>0 .and. trim(cs%blockName%name)==trim(line(:iso-1)))
then
1017 fullpathparameter = .true.
1018 line = trim(line(iso+1:last))
1019 last = len_trim(line)
1024 inwrongblock = .false.
1025 if (len_trim(blockname)>0)
then
1026 if (trim(cs%blockName%name)/=trim(blockname)) inwrongblock = .true.
1028 if (len_trim(cs%blockName%name)>0)
then
1029 if (trim(cs%blockName%name)/=trim(blockname)) inwrongblock = .true.
1033 if (line(last:last)==
'/')
then
1034 if (len_trim(blockname)==0 .and. is_root_pe())
call mom_error(fatal, &
1035 'get_variable_line: An extra namelist/block end was encountered. Line="'// &
1036 trim(line(:last))//
'"' )
1040 if (inwrongblock .and. .not. fullpathparameter)
then
1041 if (index(
" "//line(:last+1),
" "//trim(varname)//
" ")>0) &
1042 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1043 ' found outside of block '//trim(cs%blockName%name)//
'%. Ignoring.')
1048 if (index(
" "//line(:last)//
" ",
" "//trim(varname)//
" ") == 0) cycle
1051 found_equals = .false.
1052 isd = index(line(:last),
"define" )
1053 isu = index(line(:last),
"undef" )
1054 ise = index(line(:last),
" = " );
if (ise > 1) found_equals = .true.
1055 if (index(line(:last),
"#define ")==1) found_define = .true.
1056 if (index(line(:last),
"#undef ")==1) found_undef = .true.
1059 if (is_root_pe())
then
1060 if (.not. (found_define .or. found_undef .or. found_equals)) &
1061 call mom_error(fatal,
"MOM_file_parser : the parameter name '"// &
1062 trim(varname)//
"' was found without define or undef."// &
1063 " Line: '"//trim(line(:last))//
"'"//&
1064 " in file "//trim(filename)//
".")
1065 if (found_define .and. found_undef)
call mom_error(fatal, &
1066 "MOM_file_parser : Both 'undef' and 'define' occur."// &
1067 " Line: '"//trim(line(:last))//
"'"//&
1068 " in file "//trim(filename)//
".")
1069 if (found_equals .and. (found_define .or. found_undef)) &
1070 call mom_error(fatal, &
1071 "MOM_file_parser : Both 'a=b' and 'undef/define' syntax occur."// &
1072 " Line: '"//trim(line(:last))//
"'"//&
1073 " in file "//trim(filename)//
".")
1074 if (found_override .and. .not. (found_define .or. found_undef .or. found_equals)) &
1075 call mom_error(fatal,
"MOM_file_parser : override was found "// &
1076 " without a define or undef."// &
1077 " Line: '"//trim(line(:last))//
"'"//&
1078 " in file "//trim(filename)//
".")
1082 if (found_define)
then
1084 is = isd + 5 + scan(line(isd+6:last), set)
1086 id = scan(line(is:last),
' ')
1089 lname = trim(line(is:last))
1090 if (trim(lname) /= trim(varname)) cycle
1094 lname = trim(line(is:is+id-1))
1095 if (trim(lname) /= trim(varname)) cycle
1096 val_str = trim(adjustl(line(is+id:last)))
1098 found = .true. ; defined_in_line = .true.
1099 elseif (found_undef)
then
1101 is = isu + 4 + scan(line(isu+5:last), set)
1103 id = scan(line(is:last),
' ')
1104 if (id > 0) last = is + id - 1
1105 lname = trim(line(is:last))
1106 if (trim(lname) /= trim(varname)) cycle
1108 found = .true. ; defined_in_line = .false.
1109 elseif (found_equals)
then
1111 is = scan(line(1:ise), set)
1112 lname = trim(line(is:ise-1))
1113 if (trim(lname) /= trim(varname)) cycle
1114 val_str = trim(adjustl(line(ise+3:last)))
1115 if (variablekindislogical)
then
1116 read(val_str(:len_trim(val_str)),*) defined_in_line
1118 defined_in_line = .true.
1122 call mom_error(fatal,
"MOM_file_parser (non-root PE?): the parameter name '"// &
1123 trim(varname)//
"' was found without an assignment, define or undef."// &
1124 " Line: '"//trim(line(:last))//
"'"//
" in file "//trim(filename)//
".")
1131 force_cycle = .false.
1132 valueissame = (trim(val_str) == trim(value_string(max_vals)))
1133 if (found_override .and. (oval >= max_vals))
then
1134 if (is_root_pe())
then
1135 if ((defined_in_line .neqv. defined) .or. .not. valueissame)
then
1136 call mom_error(fatal,
"MOM_file_parser : "//trim(varname)// &
1137 " found with multiple inconsistent overrides."// &
1138 " Line A: '"//trim(value_string(max_vals))//
"'"//&
1139 " Line B: '"//trim(line(:last))//
"'"//&
1140 " in file "//trim(filename)//
" caused the model failure.")
1142 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1143 " over-ridden more times than is permitted."// &
1144 " Line: '"//trim(line(:last))//
"'"//&
1145 " in file "//trim(filename)//
" is being ignored.")
1148 force_cycle = .true.
1150 if (.not.found_override .and. (oval > 0))
then
1152 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1153 " has already been over-ridden."// &
1154 " Line: '"//trim(line(:last))//
"'"//&
1155 " in file "//trim(filename)//
" is being ignored.")
1156 force_cycle = .true.
1158 if (.not.found_override .and. (ival >= max_vals))
then
1159 if (is_root_pe())
then
1160 if ((defined_in_line .neqv. defined) .or. .not. valueissame)
then
1161 call mom_error(fatal,
"MOM_file_parser : "//trim(varname)// &
1162 " found with multiple inconsistent definitions."// &
1163 " Line A: '"//trim(value_string(max_vals))//
"'"//&
1164 " Line B: '"//trim(line(:last))//
"'"//&
1165 " in file "//trim(filename)//
" caused the model failure.")
1167 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1168 " occurs more times than is permitted."// &
1169 " Line: '"//trim(line(:last))//
"'"//&
1170 " in file "//trim(filename)//
" is being ignored.")
1173 force_cycle = .true.
1175 if (force_cycle) cycle
1178 if (found_override)
then
1180 value_string(oval) = trim(val_str)
1181 defined = defined_in_line
1182 if (verbose > 0 .and. ival > 0 .and. is_root_pe() .and. &
1184 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1185 " over-ridden. Line: '"//trim(line(:last))//
"'"//&
1186 " in file "//trim(filename)//
".")
1189 value_string(ival) = trim(val_str)
1190 defined = defined_in_line
1191 if (verbose > 1 .and. is_root_pe()) &
1192 call mom_error(warning,
"MOM_file_parser : "//trim(varname)// &
1193 " set. Line: '"//trim(line(:last))//
"'"//&
1194 " in file "//trim(filename)//
".")
1199 if (len_trim(blockname)>0 .and. is_root_pe())
call mom_error(fatal, &
1200 'A namelist/parameter block was not closed. Last open block appears '// &
1201 'to be "'//trim(blockname)//
'".')
1203 enddo paramfile_loop
1209 logical,
dimension(:),
pointer :: line_used
1210 integer,
intent(in) :: count
1211 line_used(count) = .true.
1218 character(len=*),
intent(in) :: varname
1221 type(
link_parameter),
pointer :: newlink => null(), this => null()
1225 do while(
associated(this) )
1226 if (trim(varname) == trim(this%name))
then
1233 newlink%name = trim(varname)
1234 newlink%hasIssuedOverrideWarning = .true.
1235 newlink%next => chain
1245 character(len=*),
intent(in) :: modulename
1246 character(len=*),
intent(in) :: version
1247 character(len=*),
optional,
intent(in) :: desc
1249 character(len=240) :: mesg
1251 mesg = trim(modulename)//
": "//trim(version)
1252 if (is_root_pe())
then
1253 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1254 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1257 if (
present(desc))
call doc_module(cs%doc, modulename, desc)
1263 character(len=*),
intent(in) :: modulename
1264 character(len=*),
intent(in) :: version
1266 character(len=240) :: mesg
1268 mesg = trim(modulename)//
": "//trim(version)
1269 if (is_root_pe())
then
1270 write(stdlog(),
'(a)') trim(mesg)
1276 subroutine log_param_int(CS, modulename, varname, value, desc, units, &
1277 default, layoutParam, debuggingParam)
1280 character(len=*),
intent(in) :: modulename
1281 character(len=*),
intent(in) :: varname
1282 integer,
intent(in) ::
value
1283 character(len=*),
optional,
intent(in) :: desc
1285 character(len=*),
optional,
intent(in) :: units
1286 integer,
optional,
intent(in) :: default
1287 logical,
optional,
intent(in) :: layoutParam
1289 logical,
optional,
intent(in) :: debuggingParam
1292 character(len=240) :: mesg, myunits
1294 write(mesg,
'(" ",a," ",a,": ",a)') trim(modulename), trim(varname), trim(left_int(
value))
1295 if (is_root_pe())
then
1296 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1297 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1300 myunits=
" ";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1301 if (
present(desc)) &
1302 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1303 layoutparam=layoutparam, debuggingparam=debuggingparam)
1309 units, default, layoutParam, debuggingParam)
1312 character(len=*),
intent(in) :: modulename
1313 character(len=*),
intent(in) :: varname
1314 integer,
dimension(:),
intent(in) ::
value
1315 character(len=*),
optional,
intent(in) :: desc
1317 character(len=*),
optional,
intent(in) :: units
1318 integer,
optional,
intent(in) :: default
1319 logical,
optional,
intent(in) :: layoutParam
1321 logical,
optional,
intent(in) :: debuggingParam
1324 character(len=1320) :: mesg
1325 character(len=240) :: myunits
1327 write(mesg,
'(" ",a," ",a,": ",A)') trim(modulename), trim(varname), trim(left_ints(
value))
1328 if (is_root_pe())
then
1329 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1330 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1333 myunits=
" ";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1334 if (
present(desc)) &
1335 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1336 layoutparam=layoutparam, debuggingparam=debuggingparam)
1341 subroutine log_param_real(CS, modulename, varname, value, desc, units, &
1342 default, debuggingParam)
1345 character(len=*),
intent(in) :: modulename
1346 character(len=*),
intent(in) :: varname
1347 real,
intent(in) ::
value
1348 character(len=*),
optional,
intent(in) :: desc
1350 character(len=*),
optional,
intent(in) :: units
1351 real,
optional,
intent(in) :: default
1352 logical,
optional,
intent(in) :: debuggingParam
1355 character(len=240) :: mesg, myunits
1357 write(mesg,
'(" ",a," ",a,": ",a)') &
1358 trim(modulename), trim(varname), trim(left_real(
value))
1359 if (is_root_pe())
then
1360 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1361 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1364 myunits=
"not defined";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1365 if (
present(desc)) &
1366 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1367 debuggingparam=debuggingparam)
1373 units, default, debuggingParam)
1376 character(len=*),
intent(in) :: modulename
1377 character(len=*),
intent(in) :: varname
1378 real,
dimension(:),
intent(in) ::
value
1379 character(len=*),
optional,
intent(in) :: desc
1381 character(len=*),
optional,
intent(in) :: units
1382 real,
optional,
intent(in) :: default
1383 logical,
optional,
intent(in) :: debuggingParam
1386 character(len=1320) :: mesg
1387 character(len=240) :: myunits
1392 write(mesg,
'(" ",a," ",a,": ",a)') &
1393 trim(modulename), trim(varname), trim(left_reals(
value))
1394 if (is_root_pe())
then
1395 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1396 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1399 myunits=
"not defined";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1400 if (
present(desc)) &
1401 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1402 debuggingparam=debuggingparam)
1408 units, default, layoutParam, debuggingParam)
1411 character(len=*),
intent(in) :: modulename
1412 character(len=*),
intent(in) :: varname
1413 logical,
intent(in) ::
value
1414 character(len=*),
optional,
intent(in) :: desc
1416 character(len=*),
optional,
intent(in) :: units
1417 logical,
optional,
intent(in) :: default
1418 logical,
optional,
intent(in) :: layoutParam
1420 logical,
optional,
intent(in) :: debuggingParam
1423 character(len=240) :: mesg, myunits
1426 write(mesg,
'(" ",a," ",a,": True")') trim(modulename), trim(varname)
1428 write(mesg,
'(" ",a," ",a,": False")') trim(modulename), trim(varname)
1430 if (is_root_pe())
then
1431 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1432 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1435 myunits=
"Boolean";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1436 if (
present(desc)) &
1437 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1438 layoutparam=layoutparam, debuggingparam=debuggingparam)
1443 subroutine log_param_char(CS, modulename, varname, value, desc, units, &
1444 default, layoutParam, debuggingParam)
1447 character(len=*),
intent(in) :: modulename
1448 character(len=*),
intent(in) :: varname
1449 character(len=*),
intent(in) ::
value
1450 character(len=*),
optional,
intent(in) :: desc
1452 character(len=*),
optional,
intent(in) :: units
1453 character(len=*),
optional,
intent(in) :: default
1454 logical,
optional,
intent(in) :: layoutParam
1456 logical,
optional,
intent(in) :: debuggingParam
1459 character(len=240) :: mesg, myunits
1461 write(mesg,
'(" ",a," ",a,": ",a)') &
1462 trim(modulename), trim(varname), trim(
value)
1463 if (is_root_pe())
then
1464 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1465 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1468 myunits=
" ";
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1469 if (
present(desc)) &
1470 call doc_param(cs%doc, varname, desc, myunits,
value, default, &
1471 layoutparam=layoutparam, debuggingparam=debuggingparam)
1477 subroutine log_param_time(CS, modulename, varname, value, desc, units, &
1478 default, timeunit, layoutParam, debuggingParam, log_date)
1481 character(len=*),
intent(in) :: modulename
1482 character(len=*),
intent(in) :: varname
1483 type(time_type),
intent(in) ::
value
1484 character(len=*),
optional,
intent(in) :: desc
1486 character(len=*),
optional,
intent(in) :: units
1487 type(time_type),
optional,
intent(in) :: default
1488 real,
optional,
intent(in) :: timeunit
1490 logical,
optional,
intent(in) :: log_date
1492 logical,
optional,
intent(in) :: layoutParam
1494 logical,
optional,
intent(in) :: debuggingParam
1498 real :: real_time, real_default
1499 logical :: use_timeunit, date_format
1500 character(len=240) :: mesg, myunits
1501 character(len=80) :: date_string, default_string
1502 integer :: days, secs, ticks, ticks_per_sec
1504 use_timeunit = .false.
1505 date_format = .false. ;
if (
present(log_date)) date_format = log_date
1507 call get_time(
value, secs, days, ticks)
1509 if (ticks == 0)
then
1510 write(mesg,
'(" ",a," ",a," (Time): ",i0,":",i0)') trim(modulename), &
1511 trim(varname), days, secs
1513 write(mesg,
'(" ",a," ",a," (Time): ",i0,":",i0,":",i0)') trim(modulename), &
1514 trim(varname), days, secs, ticks
1516 if (is_root_pe())
then
1517 if (cs%log_open)
write(cs%stdlog,
'(a)') trim(mesg)
1518 if (cs%log_to_stdout)
write(cs%stdout,
'(a)') trim(mesg)
1521 if (
present(desc))
then
1522 if (
present(timeunit)) use_timeunit = (timeunit > 0.0)
1523 if (date_format)
then
1527 if (
present(default))
then
1529 call doc_param(cs%doc, varname, desc, myunits, date_string, &
1530 default=default_string, layoutparam=layoutparam, &
1531 debuggingparam=debuggingparam)
1533 call doc_param(cs%doc, varname, desc, myunits, date_string, &
1534 layoutparam=layoutparam, debuggingparam=debuggingparam)
1536 elseif (use_timeunit)
then
1537 if (
present(units))
then
1538 write(myunits(1:240),
'(A)') trim(units)
1540 if (abs(timeunit-1.0) < 0.01)
then ; myunits =
"seconds"
1541 elseif (abs(timeunit-3600.0) < 1.0)
then ; myunits =
"hours"
1542 elseif (abs(timeunit-86400.0) < 1.0)
then ; myunits =
"days"
1543 elseif (abs(timeunit-3.1e7) < 1.0e6)
then ; myunits =
"years"
1544 else ;
write(myunits,
'(es8.2," sec")') timeunit ;
endif
1546 real_time = (86400.0/timeunit)*days + secs/timeunit
1547 if (ticks > 0) real_time = real_time + &
1548 real(ticks) / (timeunit*get_ticks_per_second())
1549 if (
present(default))
then
1550 call get_time(default, secs, days, ticks)
1551 real_default = (86400.0/timeunit)*days + secs/timeunit
1552 if (ticks > 0) real_default = real_default + &
1553 real(ticks) / (timeunit*get_ticks_per_second())
1554 call doc_param(cs%doc, varname, desc, myunits, real_time, real_default)
1556 call doc_param(cs%doc, varname, desc, myunits, real_time)
1559 myunits=
'not defined';
if (
present(units))
write(myunits(1:240),
'(A)') trim(units)
1560 call doc_param(cs%doc, varname, desc, myunits,
value, default)
1568 type(time_type),
intent(in) :: date
1569 character(len=40) :: date_string
1572 character(len=40) :: sub_string
1574 integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec
1576 call get_date(date, yrs, mons, days, hours, mins, secs, ticks)
1577 write (date_string,
'(i8.4)') yrs
1578 write (sub_string,
'("-", i2.2, "-", I2.2, " ", i2.2, ":", i2.2, ":")') &
1579 mons, days, hours, mins
1580 date_string = trim(adjustl(date_string)) // trim(sub_string)
1582 ticks_per_sec = get_ticks_per_second()
1583 real_secs = secs + ticks/ticks_per_sec
1584 if (ticks_per_sec <= 100)
then
1585 write (sub_string,
'(F7.3)') real_secs
1587 write (sub_string,
'(F10.6)') real_secs
1590 write (sub_string,
'(i2.2)') secs
1592 date_string = trim(date_string) // trim(adjustl(sub_string))
1598 subroutine get_param_int(CS, modulename, varname, value, desc, units, &
1599 default, fail_if_missing, do_not_read, do_not_log, &
1600 static_value, layoutParam, debuggingParam)
1603 character(len=*),
intent(in) :: modulename
1604 character(len=*),
intent(in) :: varname
1605 integer,
intent(inout) ::
value
1607 character(len=*),
optional,
intent(in) :: desc
1609 character(len=*),
optional,
intent(in) :: units
1610 integer,
optional,
intent(in) :: default
1611 integer,
optional,
intent(in) :: static_value
1614 logical,
optional,
intent(in) :: fail_if_missing
1616 logical,
optional,
intent(in) :: do_not_read
1618 logical,
optional,
intent(in) :: do_not_log
1620 logical,
optional,
intent(in) :: layoutParam
1622 logical,
optional,
intent(in) :: debuggingParam
1625 logical :: do_read, do_log
1627 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1628 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1631 if (
present(default))
value = default
1632 if (
present(static_value))
value = static_value
1637 call log_param_int(cs, modulename, varname,
value, desc, units, &
1638 default, layoutparam, debuggingparam)
1646 default, fail_if_missing, do_not_read, do_not_log, &
1647 static_value, layoutParam, debuggingParam)
1650 character(len=*),
intent(in) :: modulename
1651 character(len=*),
intent(in) :: varname
1652 integer,
dimension(:),
intent(inout) ::
value
1654 character(len=*),
optional,
intent(in) :: desc
1656 character(len=*),
optional,
intent(in) :: units
1657 integer,
optional,
intent(in) :: default
1658 integer,
optional,
intent(in) :: static_value
1661 logical,
optional,
intent(in) :: fail_if_missing
1663 logical,
optional,
intent(in) :: do_not_read
1665 logical,
optional,
intent(in) :: do_not_log
1667 logical,
optional,
intent(in) :: layoutParam
1669 logical,
optional,
intent(in) :: debuggingParam
1672 logical :: do_read, do_log
1674 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1675 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1678 if (
present(default))
then ; value(:) = default ;
endif
1679 if (
present(static_value))
then ; value(:) = static_value ;
endif
1685 units, default, layoutparam, debuggingparam)
1692 subroutine get_param_real(CS, modulename, varname, value, desc, units, &
1693 default, fail_if_missing, do_not_read, do_not_log, &
1694 static_value, debuggingParam, scale, unscaled)
1697 character(len=*),
intent(in) :: modulename
1698 character(len=*),
intent(in) :: varname
1699 real,
intent(inout) ::
value
1701 character(len=*),
optional,
intent(in) :: desc
1703 character(len=*),
optional,
intent(in) :: units
1704 real,
optional,
intent(in) :: default
1705 real,
optional,
intent(in) :: static_value
1708 logical,
optional,
intent(in) :: fail_if_missing
1710 logical,
optional,
intent(in) :: do_not_read
1712 logical,
optional,
intent(in) :: do_not_log
1714 logical,
optional,
intent(in) :: debuggingParam
1716 real,
optional,
intent(in) :: scale
1718 real,
optional,
intent(out) :: unscaled
1721 logical :: do_read, do_log
1723 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1724 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1727 if (
present(default))
value = default
1728 if (
present(static_value))
value = static_value
1733 call log_param_real(cs, modulename, varname,
value, desc, units, &
1734 default, debuggingparam)
1737 if (
present(unscaled)) unscaled =
value
1738 if (
present(scale))
value = scale*
value
1745 default, fail_if_missing, do_not_read, do_not_log, debuggingParam, &
1746 static_value, scale, unscaled)
1749 character(len=*),
intent(in) :: modulename
1750 character(len=*),
intent(in) :: varname
1751 real,
dimension(:),
intent(inout) ::
value
1753 character(len=*),
optional,
intent(in) :: desc
1755 character(len=*),
optional,
intent(in) :: units
1756 real,
optional,
intent(in) :: default
1757 real,
optional,
intent(in) :: static_value
1760 logical,
optional,
intent(in) :: fail_if_missing
1762 logical,
optional,
intent(in) :: do_not_read
1764 logical,
optional,
intent(in) :: do_not_log
1766 logical,
optional,
intent(in) :: debuggingParam
1768 real,
optional,
intent(in) :: scale
1770 real,
dimension(:),
optional,
intent(out) :: unscaled
1773 logical :: do_read, do_log
1775 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1776 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1779 if (
present(default))
then ; value(:) = default ;
endif
1780 if (
present(static_value))
then ; value(:) = static_value ;
endif
1786 units, default, debuggingparam)
1789 if (
present(unscaled)) unscaled(:) = value(:)
1790 if (
present(scale)) value(:) = scale*value(:)
1796 subroutine get_param_char(CS, modulename, varname, value, desc, units, &
1797 default, fail_if_missing, do_not_read, do_not_log, &
1798 static_value, layoutParam, debuggingParam)
1801 character(len=*),
intent(in) :: modulename
1802 character(len=*),
intent(in) :: varname
1803 character(len=*),
intent(inout) ::
value
1805 character(len=*),
optional,
intent(in) :: desc
1807 character(len=*),
optional,
intent(in) :: units
1808 character(len=*),
optional,
intent(in) :: default
1809 character(len=*),
optional,
intent(in) :: static_value
1812 logical,
optional,
intent(in) :: fail_if_missing
1814 logical,
optional,
intent(in) :: do_not_read
1816 logical,
optional,
intent(in) :: do_not_log
1818 logical,
optional,
intent(in) :: layoutParam
1820 logical,
optional,
intent(in) :: debuggingParam
1823 logical :: do_read, do_log
1825 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1826 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1829 if (
present(default))
value = default
1830 if (
present(static_value))
value = static_value
1835 call log_param_char(cs, modulename, varname,
value, desc, units, &
1836 default, layoutparam, debuggingparam)
1844 default, fail_if_missing, do_not_read, do_not_log, static_value)
1847 character(len=*),
intent(in) :: modulename
1848 character(len=*),
intent(in) :: varname
1849 character(len=*),
dimension(:),
intent(inout) ::
value
1851 character(len=*),
optional,
intent(in) :: desc
1853 character(len=*),
optional,
intent(in) :: units
1854 character(len=*),
optional,
intent(in) :: default
1855 character(len=*),
optional,
intent(in) :: static_value
1858 logical,
optional,
intent(in) :: fail_if_missing
1860 logical,
optional,
intent(in) :: do_not_read
1862 logical,
optional,
intent(in) :: do_not_log
1866 logical :: do_read, do_log
1867 integer :: i, len_tot, len_val
1868 character(len=240) :: cat_val
1870 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1871 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1874 if (
present(default))
then ; value(:) = default ;
endif
1875 if (
present(static_value))
then ; value(:) = static_value ;
endif
1880 cat_val = trim(value(1)); len_tot = len_trim(value(1))
1882 len_val = len_trim(value(i))
1883 if ((len_val > 0) .and. (len_tot + len_val + 2 < 240))
then
1884 cat_val = trim(cat_val)//achar(34)//
", "//achar(34)//trim(value(i))
1885 len_tot = len_tot + len_val
1897 default, fail_if_missing, do_not_read, do_not_log, &
1898 static_value, layoutParam, debuggingParam)
1901 character(len=*),
intent(in) :: modulename
1902 character(len=*),
intent(in) :: varname
1903 logical,
intent(inout) ::
value
1905 character(len=*),
optional,
intent(in) :: desc
1907 character(len=*),
optional,
intent(in) :: units
1908 logical,
optional,
intent(in) :: default
1909 logical,
optional,
intent(in) :: static_value
1912 logical,
optional,
intent(in) :: fail_if_missing
1914 logical,
optional,
intent(in) :: do_not_read
1916 logical,
optional,
intent(in) :: do_not_log
1918 logical,
optional,
intent(in) :: layoutParam
1920 logical,
optional,
intent(in) :: debuggingParam
1923 logical :: do_read, do_log
1925 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1926 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1929 if (
present(default))
value = default
1930 if (
present(static_value))
value = static_value
1936 units, default, layoutparam, debuggingparam)
1943 subroutine get_param_time(CS, modulename, varname, value, desc, units, &
1944 default, fail_if_missing, do_not_read, do_not_log, &
1945 timeunit, static_value, layoutParam, debuggingParam, &
1949 character(len=*),
intent(in) :: modulename
1950 character(len=*),
intent(in) :: varname
1951 type(time_type),
intent(inout) ::
value
1953 character(len=*),
optional,
intent(in) :: desc
1955 character(len=*),
optional,
intent(in) :: units
1956 type(time_type),
optional,
intent(in) :: default
1957 type(time_type),
optional,
intent(in) :: static_value
1960 logical,
optional,
intent(in) :: fail_if_missing
1962 logical,
optional,
intent(in) :: do_not_read
1964 logical,
optional,
intent(in) :: do_not_log
1966 real,
optional,
intent(in) :: timeunit
1968 logical,
optional,
intent(in) :: layoutParam
1970 logical,
optional,
intent(in) :: debuggingParam
1972 logical,
optional,
intent(in) :: log_as_date
1975 logical :: do_read, do_log, date_format, log_date
1977 do_read = .true. ;
if (
present(do_not_read)) do_read = .not.do_not_read
1978 do_log = .true. ;
if (
present(do_not_log)) do_log = .not.do_not_log
1982 if (
present(default))
value = default
1983 if (
present(static_value))
value = static_value
1984 call read_param_time(cs, varname,
value, timeunit, fail_if_missing, date_format=log_date)
1988 if (
present(log_as_date)) log_date = log_as_date
1989 call log_param_time(cs, modulename, varname,
value, desc, units, default, &
1990 timeunit, layoutparam=layoutparam, &
1991 debuggingparam=debuggingparam, log_date=log_date)
2004 if (
associated(cs%blockName))
then
2005 block => cs%blockName
2008 if (is_root_pe())
call mom_error(fatal, &
2009 'clearParameterBlock: A clear was attempted before allocation.')
2017 character(len=*),
intent(in) :: blockname
2018 character(len=*),
optional,
intent(in) :: desc
2021 if (
associated(cs%blockName))
then
2022 block => cs%blockName
2024 call doc_openblock(cs%doc,block%name,desc)
2026 if (is_root_pe())
call mom_error(fatal, &
2027 'openParameterBlock: A push was attempted before allocation.')
2038 if (
associated(cs%blockName))
then
2039 block => cs%blockName
2040 if (is_root_pe().and.len_trim(block%name)==0)
call mom_error(fatal, &
2041 'closeParameterBlock: A pop was attempted on an empty stack. ("'//&
2042 trim(block%name)//
'")')
2043 call doc_closeblock(cs%doc,block%name)
2045 if (is_root_pe())
call mom_error(fatal, &
2046 'closeParameterBlock: A pop was attempted before allocation.')
2053 character(len=*),
intent(in) :: oldblockname
2054 character(len=*),
intent(in) :: newblockname
2057 if (len_trim(oldblockname)>0)
then
2066 character(len=*),
intent(in) :: oldblockname
2070 i = index(trim(oldblockname),
'%', .true.)
2076 if (is_root_pe())
call mom_error(fatal, &
2077 'popBlockLevel: A pop was attempted leaving an empty block name.')