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