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 | !> Handy functions for manipulating strings | |
| 6 | module MOM_string_functions | |
| 7 | ||
| 8 | use iso_fortran_env, only : stdout=>output_unit, stderr=>error_unit | |
| 9 | ||
| 10 | implicit none ; private | |
| 11 | ||
| 12 | public lowercase, uppercase | |
| 13 | public left_int, left_ints | |
| 14 | public left_real, left_reals | |
| 15 | public string_functions_unit_tests | |
| 16 | public extractWord | |
| 17 | public extract_word | |
| 18 | public extract_integer | |
| 19 | public extract_real | |
| 20 | public remove_spaces | |
| 21 | public slasher | |
| 22 | public trim_trailing_commas | |
| 23 | public ints_to_string | |
| 24 | ||
| 25 | contains | |
| 26 | ||
| 27 | !> Return a string in which all uppercase letters have been replaced by | |
| 28 | !! their lowercase counterparts. | |
| 29 | 43 | function lowercase(input_string) |
| 30 | character(len=*), intent(in) :: input_string !< The string to modify | |
| 31 | character(len=len(input_string)) :: lowercase !< The modified output string | |
| 32 | ! This function returns a string in which all uppercase letters have been | |
| 33 | ! replaced by their lowercase counterparts. It is loosely based on the | |
| 34 | ! lowercase function in mpp_util.F90. | |
| 35 | integer, parameter :: co=iachar('a')-iachar('A') ! case offset | |
| 36 | integer :: k | |
| 37 | ||
| 38 | 43 | lowercase = input_string |
| 39 | 1226 | do k=1, len_trim(input_string) |
| 40 | 1183 | if (lowercase(k:k) >= 'A' .and. lowercase(k:k) <= 'Z') & |
| 41 | 146 | lowercase(k:k) = achar(ichar(lowercase(k:k))+co) |
| 42 | enddo | |
| 43 | 43 | end function lowercase |
| 44 | ||
| 45 | !> Return a string in which all uppercase letters have been replaced by | |
| 46 | !! their lowercase counterparts. | |
| 47 | 633 | function uppercase(input_string) |
| 48 | character(len=*), intent(in) :: input_string !< The string to modify | |
| 49 | character(len=len(input_string)) :: uppercase !< The modified output string | |
| 50 | ! This function returns a string in which all lowercase letters have been | |
| 51 | ! replaced by their uppercase counterparts. It is loosely based on the | |
| 52 | ! uppercase function in mpp_util.F90. | |
| 53 | integer, parameter :: co=iachar('A')-iachar('a') ! case offset | |
| 54 | integer :: k | |
| 55 | ||
| 56 | 633 | uppercase = input_string |
| 57 | 3839 | do k=1, len_trim(input_string) |
| 58 | 3206 | if (uppercase(k:k) >= 'a' .and. uppercase(k:k) <= 'z') & |
| 59 | 639 | uppercase(k:k) = achar(ichar(uppercase(k:k))+co) |
| 60 | enddo | |
| 61 | 633 | end function uppercase |
| 62 | ||
| 63 | !> Returns a character string of a left-formatted integer | |
| 64 | !! e.g. "123 " (assumes 19 digit maximum) | |
| 65 | 91 | function left_int(i) |
| 66 | integer, intent(in) :: i !< The integer to convert to a string | |
| 67 | character(len=19) :: left_int !< The output string | |
| 68 | ||
| 69 | character(len=19) :: tmp | |
| 70 | 91 | write(tmp(1:19),'(I19)') i |
| 71 | 91 | write(left_int(1:19),'(A)') adjustl(tmp) |
| 72 | 91 | end function left_int |
| 73 | ||
| 74 | !> Returns a character string of a comma-separated, compact formatted, | |
| 75 | !! integers e.g. "1, 2, 3, 4" | |
| 76 | 2 | function left_ints(i) |
| 77 | integer, intent(in) :: i(:) !< The array of integers to convert to a string | |
| 78 | character(len=1320) :: left_ints !< The output string | |
| 79 | ||
| 80 | character(len=1320) :: tmp | |
| 81 | integer :: j | |
| 82 | 2 | write(left_ints(1:1320),'(A)') trim(left_int(i(1))) |
| 83 | 2 | if (size(i)>1) then |
| 84 | 4 | do j=2,size(i) |
| 85 | 2 | tmp=left_ints |
| 86 | 4 | write(left_ints(1:1320),'(A,", ",A)') trim(tmp),trim(left_int(i(j))) |
| 87 | enddo | |
| 88 | endif | |
| 89 | 2 | end function left_ints |
| 90 | ||
| 91 | !> Returns a left-justified string with a real formatted like '(G)' | |
| 92 | 376 | function left_real(val) |
| 93 | real, intent(in) :: val !< The real variable to convert to a string, in arbitrary units [A] | |
| 94 | character(len=32) :: left_real !< The output string | |
| 95 | ||
| 96 | integer :: l, ind | |
| 97 | ||
| 98 | 376 | if ((abs(val) < 1.0e4) .and. (abs(val) >= 1.0e-3)) then |
| 99 | 249 | write(left_real, '(F30.11)') val |
| 100 | 249 | if (.not.isFormattedFloatEqualTo(left_real,val)) then |
| 101 | 23 | write(left_real, '(F30.12)') val |
| 102 | 23 | if (.not.isFormattedFloatEqualTo(left_real,val)) then |
| 103 | 23 | write(left_real, '(F30.13)') val |
| 104 | 23 | if (.not.isFormattedFloatEqualTo(left_real,val)) then |
| 105 | 21 | write(left_real, '(F30.14)') val |
| 106 | 21 | if (.not.isFormattedFloatEqualTo(left_real,val)) then |
| 107 | 9 | write(left_real, '(F30.15)') val |
| 108 | 9 | if (.not.isFormattedFloatEqualTo(left_real,val)) then |
| 109 | 0 | write(left_real, '(F30.16)') val |
| 110 | endif | |
| 111 | endif | |
| 112 | endif | |
| 113 | endif | |
| 114 | endif | |
| 115 | 2185 | do |
| 116 | 2434 | l = len_trim(left_real) |
| 117 | 2434 | if ((l<2) .or. (left_real(l-1:l) == ".0") .or. & |
| 118 | 249 | (left_real(l:l) /= "0")) exit |
| 119 | 2185 | left_real(l:l) = " " |
| 120 | enddo | |
| 121 | 127 | elseif (val == 0.) then |
| 122 | 88 | left_real = "0.0" |
| 123 | else | |
| 124 | 39 | if ((abs(val) <= 1.0e-100) .or. (abs(val) >= 1.0e100)) then |
| 125 | 0 | write(left_real(1:32), '(ES24.14E3)') val |
| 126 | 0 | if (.not.isFormattedFloatEqualTo(left_real,val)) & |
| 127 | 0 | write(left_real(1:32), '(ES24.15E3)') val |
| 128 | else | |
| 129 | 39 | write(left_real(1:32), '(ES23.14)') val |
| 130 | 39 | if (.not.isFormattedFloatEqualTo(left_real,val)) & |
| 131 | 2 | write(left_real(1:32), '(ES23.15)') val |
| 132 | endif | |
| 133 | 482 | do |
| 134 | 521 | ind = index(left_real,"0E") |
| 135 | 521 | if (ind == 0) exit |
| 136 | 498 | if (left_real(ind-1:ind-1) == ".") exit |
| 137 | 482 | left_real = left_real(1:ind-1)//left_real(ind+1:) |
| 138 | enddo | |
| 139 | endif | |
| 140 | 376 | left_real = adjustl(left_real) |
| 141 | 376 | end function left_real |
| 142 | ||
| 143 | !> Returns a character string of a comma-separated, compact formatted, reals | |
| 144 | !! e.g. "1., 2., 5*3., 5.E2" | |
| 145 | 3 | function left_reals(r,sep) |
| 146 | real, intent(in) :: r(:) !< The array of real variables to convert to a string, in arbitrary units [A] | |
| 147 | character(len=*), optional, intent(in) :: sep !< The separator between | |
| 148 | !! successive values, by default it is ', '. | |
| 149 | character(len=:), allocatable :: left_reals !< The output string | |
| 150 | ||
| 151 | integer :: j, n, ns | |
| 152 | logical :: doWrite | |
| 153 | character(len=10) :: separator | |
| 154 | ||
| 155 | 3 | n=1 ; doWrite=.true. ; left_reals='' |
| 156 | 3 | if (present(sep)) then |
| 157 | 0 | separator=sep ; ns=len(sep) |
| 158 | else | |
| 159 | 3 | separator=', ' ; ns=2 |
| 160 | endif | |
| 161 | 84 | do j=1,size(r) |
| 162 | 81 | doWrite=.true. |
| 163 | 81 | if (j<size(r)) then |
| 164 | 78 | if (r(j)==r(j+1)) then |
| 165 | 0 | n=n+1 |
| 166 | 0 | doWrite=.false. |
| 167 | endif | |
| 168 | endif | |
| 169 | 84 | if (doWrite) then |
| 170 | 81 | if (len(left_reals)>0) then ! Write separator if a number has already been written |
| 171 | 78 | left_reals = left_reals // separator(1:ns) |
| 172 | endif | |
| 173 | 81 | if (n>1) then |
| 174 | 0 | left_reals = left_reals // trim(left_int(n)) // "*" // trim(left_real(r(j))) |
| 175 | else | |
| 176 | 81 | left_reals = left_reals // trim(left_real(r(j))) |
| 177 | endif | |
| 178 | 81 | n=1 |
| 179 | endif | |
| 180 | enddo | |
| 181 | 3 | end function left_reals |
| 182 | ||
| 183 | !> Returns True if the string can be read/parsed to give the exact value of "val" | |
| 184 | 364 | function isFormattedFloatEqualTo(str, val) |
| 185 | character(len=*), intent(in) :: str !< The string to parse | |
| 186 | real, intent(in) :: val !< The real value to compare with, in arbitrary units [A] | |
| 187 | logical :: isFormattedFloatEqualTo | |
| 188 | ! Local variables | |
| 189 | real :: scannedVal ! The value extraced from str, in arbitrary units [A] | |
| 190 | ||
| 191 | 364 | isFormattedFloatEqualTo=.false. |
| 192 | 364 | read(str(1:),*,err=987) scannedVal |
| 193 | 364 | if (scannedVal == val) isFormattedFloatEqualTo=.true. |
| 194 | 364 | 987 return |
| 195 | 364 | end function isFormattedFloatEqualTo |
| 196 | ||
| 197 | !> Returns the string corresponding to the nth word in the argument | |
| 198 | !! or "" if the string is not long enough. Both spaces and commas | |
| 199 | !! are interpreted as separators. | |
| 200 | 3 | character(len=120) function extractWord(string, n) |
| 201 | character(len=*), intent(in) :: string !< The string to scan | |
| 202 | integer, intent(in) :: n !< Number of word to extract | |
| 203 | ||
| 204 | 6 | extractWord = extract_word(string, ' ,', n) |
| 205 | ||
| 206 | 3 | end function extractWord |
| 207 | ||
| 208 | !> Returns the string corresponding to the nth word in the argument | |
| 209 | !! or "" if the string is not long enough. Words are delineated | |
| 210 | !! by the mandatory separators argument. | |
| 211 | 3 | character(len=120) function extract_word(string, separators, n) |
| 212 | character(len=*), intent(in) :: string !< String to scan | |
| 213 | character(len=*), intent(in) :: separators !< Characters to use for delineation | |
| 214 | integer, intent(in) :: n !< Number of word to extract | |
| 215 | ! Local variables | |
| 216 | integer :: ns, i, b, e, nw | |
| 217 | logical :: lastCharIsSeperator | |
| 218 | 3 | extract_word = '' |
| 219 | 3 | lastCharIsSeperator = .true. |
| 220 | 3 | ns = len_trim(string) |
| 221 | 3 | i = 0 ; b=0 ; e=0 ; nw=0 |
| 222 | 16 | do while (i<ns) |
| 223 | 15 | i = i+1 |
| 224 | 15 | if (lastCharIsSeperator) then ! search for end of word |
| 225 | 6 | if (verify(string(i:i),separators)==0) then |
| 226 | continue ! Multiple separators | |
| 227 | else | |
| 228 | 6 | lastCharIsSeperator = .false. ! character is beginning of word |
| 229 | 6 | b = i |
| 230 | continue | |
| 231 | endif | |
| 232 | else ! continue search for end of word | |
| 233 | 9 | if (verify(string(i:i),separators)==0) then |
| 234 | 5 | lastCharIsSeperator = .true. |
| 235 | 5 | e = i-1 ! Previous character is end of word |
| 236 | 5 | nw = nw+1 |
| 237 | 5 | if (nw==n) then |
| 238 | 2 | extract_word = trim(string(b:e)) |
| 239 | 2 | return |
| 240 | endif | |
| 241 | endif | |
| 242 | endif | |
| 243 | enddo | |
| 244 | 1 | if (b<=ns .and. nw==n-1) extract_word = trim(string(b:ns)) |
| 245 | 3 | end function extract_word |
| 246 | ||
| 247 | !> Returns the integer corresponding to the nth word in the argument. | |
| 248 | 0 | integer function extract_integer(string, separators, n, missing_value) |
| 249 | character(len=*), intent(in) :: string !< String to scan | |
| 250 | character(len=*), intent(in) :: separators !< Characters to use for delineation | |
| 251 | integer, intent(in) :: n !< Number of word to extract | |
| 252 | integer, optional, intent(in) :: missing_value !< Value to assign if word is missing | |
| 253 | ! Local variables | |
| 254 | character(len=20) :: word | |
| 255 | ||
| 256 | 0 | word = extract_word(string, separators, n) |
| 257 | ||
| 258 | 0 | if (len_trim(word)>0) then |
| 259 | 0 | read(word(1:len_trim(word)),*) extract_integer |
| 260 | else | |
| 261 | 0 | if (present(missing_value)) then |
| 262 | 0 | extract_integer = missing_value |
| 263 | else | |
| 264 | 0 | extract_integer = 0 |
| 265 | endif | |
| 266 | endif | |
| 267 | ||
| 268 | 0 | end function extract_integer |
| 269 | ||
| 270 | !> Returns the real corresponding to the nth word in the argument, in arbitrary units [A]. | |
| 271 | 0 | real function extract_real(string, separators, n, missing_value) |
| 272 | character(len=*), intent(in) :: string !< String to scan | |
| 273 | character(len=*), intent(in) :: separators !< Characters to use for delineation | |
| 274 | integer, intent(in) :: n !< Number of word to extract | |
| 275 | real, optional, intent(in) :: missing_value !< Value to assign if word is missing, in arbitrary units [A] | |
| 276 | ! Local variables | |
| 277 | character(len=20) :: word | |
| 278 | ||
| 279 | 0 | word = extract_word(string, separators, n) |
| 280 | ||
| 281 | 0 | if (len_trim(word)>0) then |
| 282 | 0 | read(word(1:len_trim(word)),*) extract_real |
| 283 | else | |
| 284 | 0 | if (present(missing_value)) then |
| 285 | 0 | extract_real = missing_value |
| 286 | else | |
| 287 | 0 | extract_real = 0 |
| 288 | endif | |
| 289 | endif | |
| 290 | ||
| 291 | 0 | end function extract_real |
| 292 | ||
| 293 | !> Returns string with all spaces removed. | |
| 294 | 0 | character(len=120) function remove_spaces(string) |
| 295 | character(len=*), intent(in) :: string !< String to scan | |
| 296 | ! Local variables | |
| 297 | integer :: ns, i, o | |
| 298 | logical :: lastCharIsSeperator | |
| 299 | 0 | lastCharIsSeperator = .true. |
| 300 | 0 | ns = len_trim(string) |
| 301 | 0 | i = 0 ; o = 0 |
| 302 | 0 | do while (i<ns) |
| 303 | 0 | i = i+1 |
| 304 | 0 | if (string(i:i) /= ' ') then ! Copy character to output string |
| 305 | 0 | o = o + 1 |
| 306 | 0 | remove_spaces(o:o) = string(i:i) |
| 307 | endif | |
| 308 | enddo | |
| 309 | 0 | do i = o+1, 120 |
| 310 | 0 | remove_spaces(i:i) = ' ' ! Wipe any non-empty characters |
| 311 | enddo | |
| 312 | 0 | remove_spaces = trim(remove_spaces) |
| 313 | 0 | end function remove_spaces |
| 314 | ||
| 315 | !> Returns true if a unit test of string_functions fails. | |
| 316 | 0 | logical function string_functions_unit_tests(verbose) |
| 317 | ! Arguments | |
| 318 | logical, intent(in) :: verbose !< If true, write results to stdout | |
| 319 | ! Local variables | |
| 320 | integer :: i(5) = (/ -1, 1, 3, 3, 0 /) | |
| 321 | ! This is an array of real test values, in arbitrary units [A] | |
| 322 | real :: r(8) = (/ 0., 1., -2., 1.3, 3.E-11, 3.E-11, 3.E-11, -5.1E12 /) | |
| 323 | logical :: fail, v | |
| 324 | 0 | fail = .false. |
| 325 | 0 | v = verbose |
| 326 | 0 | write(stdout,*) '==== MOM_string_functions: string_functions_unit_tests ===' |
| 327 | 0 | fail = fail .or. localTestS(v,left_int(-1),'-1') |
| 328 | 0 | fail = fail .or. localTestS(v,left_ints(i(:)),'-1, 1, 3, 3, 0') |
| 329 | 0 | fail = fail .or. localTestS(v,left_real(0.),'0.0') |
| 330 | 0 | fail = fail .or. localTestS(v,left_reals(r(:)),'0.0, 1.0, -2.0, 1.3, 3*3.0E-11, -5.1E+12') |
| 331 | 0 | fail = fail .or. localTestS(v,left_reals(r(:),sep=' '),'0.0 1.0 -2.0 1.3 3*3.0E-11 -5.1E+12') |
| 332 | 0 | fail = fail .or. localTestS(v,left_reals(r(:),sep=','),'0.0,1.0,-2.0,1.3,3*3.0E-11,-5.1E+12') |
| 333 | 0 | fail = fail .or. localTestS(v,ints_to_string(i(:),5),'_-0001_0001_0003_0003_0000') |
| 334 | 0 | fail = fail .or. localTestS(v,ints_to_string(i(2:),2),'_0001_0003') |
| 335 | 0 | fail = fail .or. localTestS(v,ints_to_string(i(:)),'_-0001_0001_0003') |
| 336 | 0 | fail = fail .or. localTestS(v,trim_trailing_commas("One, Two, Three, "), "One, Two, Three") |
| 337 | 0 | fail = fail .or. localTestS(v,extractWord("One Two,Three",1),"One") |
| 338 | 0 | fail = fail .or. localTestS(v,extractWord("One Two,Three",2),"Two") |
| 339 | 0 | fail = fail .or. localTestS(v,extractWord("One Two,Three",3),"Three") |
| 340 | 0 | fail = fail .or. localTestS(v,extractWord("One Two, Three",3),"Three") |
| 341 | 0 | fail = fail .or. localTestS(v,extractWord(" One Two,Three",1),"One") |
| 342 | 0 | fail = fail .or. localTestS(v,extract_word("One,Two,Three",",",3),"Three") |
| 343 | 0 | fail = fail .or. localTestS(v,extract_word("One,Two,Three",",",4),"") |
| 344 | 0 | fail = fail .or. localTestS(v,remove_spaces("1 2 3"),"123") |
| 345 | 0 | fail = fail .or. localTestS(v,remove_spaces(" 1 2 3"),"123") |
| 346 | 0 | fail = fail .or. localTestS(v,remove_spaces("1 2 3 "),"123") |
| 347 | 0 | fail = fail .or. localTestS(v,remove_spaces("123"),"123") |
| 348 | 0 | fail = fail .or. localTestS(v,remove_spaces(" "),"") |
| 349 | 0 | fail = fail .or. localTestS(v,remove_spaces(""),"") |
| 350 | 0 | fail = fail .or. localTestI(v,extract_integer("1","",1),1) |
| 351 | 0 | fail = fail .or. localTestI(v,extract_integer("1,2,3",",",1),1) |
| 352 | 0 | fail = fail .or. localTestI(v,extract_integer("1,2",",",2),2) |
| 353 | 0 | fail = fail .or. localTestI(v,extract_integer("1,2",",",3),0) |
| 354 | 0 | fail = fail .or. localTestI(v,extract_integer("1,2",",",4,4),4) |
| 355 | 0 | fail = fail .or. localTestR(v,extract_real("1.","",1),1.) |
| 356 | 0 | fail = fail .or. localTestR(v,extract_real("1.,2.,3.",",",1),1.) |
| 357 | 0 | fail = fail .or. localTestR(v,extract_real("1.,2.",",",2),2.) |
| 358 | 0 | fail = fail .or. localTestR(v,extract_real("1.,2.",",",3),0.) |
| 359 | 0 | fail = fail .or. localTestR(v,extract_real("1.,2.",",",4,4.),4.) |
| 360 | 0 | if (.not. fail) write(stdout,*) 'Pass' |
| 361 | 0 | string_functions_unit_tests = fail |
| 362 | 0 | end function string_functions_unit_tests |
| 363 | ||
| 364 | !> True if str1 does not match str2. False otherwise. | |
| 365 | 0 | logical function localTestS(verbose,str1,str2) |
| 366 | logical, intent(in) :: verbose !< If true, write results to stdout | |
| 367 | character(len=*), intent(in) :: str1 !< String | |
| 368 | character(len=*), intent(in) :: str2 !< String | |
| 369 | 0 | localTestS=.false. |
| 370 | 0 | if (trim(str1)/=trim(str2)) localTestS=.true. |
| 371 | 0 | if (localTestS .or. verbose) then |
| 372 | 0 | write(stdout,*) '>'//trim(str1)//'<' |
| 373 | 0 | if (localTestS) then |
| 374 | 0 | write(stdout,*) trim(str1),':',trim(str2), '<-- FAIL' |
| 375 | 0 | write(stderr,*) trim(str1),':',trim(str2), '<-- FAIL' |
| 376 | endif | |
| 377 | endif | |
| 378 | 0 | end function localTestS |
| 379 | ||
| 380 | !> True if i1 is not equal to i2. False otherwise. | |
| 381 | 0 | logical function localTestI(verbose,i1,i2) |
| 382 | logical, intent(in) :: verbose !< If true, write results to stdout | |
| 383 | integer, intent(in) :: i1 !< Integer | |
| 384 | integer, intent(in) :: i2 !< Integer | |
| 385 | 0 | localTestI=.false. |
| 386 | 0 | if (i1/=i2) localTestI=.true. |
| 387 | 0 | if (localTestI .or. verbose) then |
| 388 | 0 | write(stdout,*) i1,i2 |
| 389 | 0 | if (localTestI) then |
| 390 | 0 | write(stdout,*) i1,'!=',i2, '<-- FAIL' |
| 391 | 0 | write(stderr,*) i1,'!=',i2, '<-- FAIL' |
| 392 | endif | |
| 393 | endif | |
| 394 | 0 | end function localTestI |
| 395 | ||
| 396 | !> True if r1 is not equal to r2. False otherwise. | |
| 397 | 0 | logical function localTestR(verbose,r1,r2) |
| 398 | logical, intent(in) :: verbose !< If true, write results to stdout | |
| 399 | real, intent(in) :: r1 !< The first value to compare, in arbitrary units [A] | |
| 400 | real, intent(in) :: r2 !< The first value to compare, in arbitrary units [A] | |
| 401 | 0 | localTestR=.false. |
| 402 | 0 | if (r1/=r2) localTestR=.true. |
| 403 | 0 | if (localTestR .or. verbose) then |
| 404 | 0 | write(stdout,*) r1,r2 |
| 405 | 0 | if (localTestR) then |
| 406 | 0 | write(stdout,*) r1,'!=',r2, '<-- FAIL' |
| 407 | 0 | write(stderr,*) r1,'!=',r2, '<-- FAIL' |
| 408 | endif | |
| 409 | endif | |
| 410 | 0 | end function localTestR |
| 411 | ||
| 412 | !> Returns a directory name that is terminated with a "/" or "./" if the | |
| 413 | !! argument is an empty string. | |
| 414 | 18 | function slasher(dir) |
| 415 | character(len=*), intent(in) :: dir !< A directory to be terminated with a "/" | |
| 416 | !! or changed to "./" if it is blank. | |
| 417 | character(len=len(dir)+2) :: slasher | |
| 418 | ||
| 419 | 18 | if (len_trim(dir) == 0) then |
| 420 | 0 | slasher = "./" |
| 421 | 18 | elseif (dir(len_trim(dir):len_trim(dir)) == '/') then |
| 422 | 11 | slasher = trim(dir) |
| 423 | else | |
| 424 | 7 | slasher = trim(dir)//"/" |
| 425 | endif | |
| 426 | 18 | end function slasher |
| 427 | ||
| 428 | !> Returns a left-adjusted string with trailing blanks and commas removed. | |
| 429 | 688 | function trim_trailing_commas(in_str) result(out_str) |
| 430 | character(len=*), intent(in) :: in_str !< A string that is to be left adjusted and have | |
| 431 | !! its trailing commas and white space removed. | |
| 432 | character(len=len(in_str)) :: out_str !< A left-adjusted version of in_str with | |
| 433 | !! trailing commas and white space removed | |
| 434 | ||
| 435 | 688 | out_str = trim(adjustl(in_str)) |
| 436 | 688 | if (len_trim(out_str) > 0) then |
| 437 | 688 | if (out_str(len_trim(out_str):len_trim(out_str)) == ",") then |
| 438 | 688 | out_str = out_str(1:len_trim(out_str) - 1) |
| 439 | endif | |
| 440 | 688 | out_str = trim(out_str) |
| 441 | endif | |
| 442 | ||
| 443 | 688 | end function trim_trailing_commas |
| 444 | ||
| 445 | !> Convert the first n elements (3 by default) of an integer array into an underscore delimited string. | |
| 446 | 45 | function ints_to_string(a, n) result(i2s) |
| 447 | integer, dimension(:), intent(in) :: a !< The array of integers to translate | |
| 448 | integer, optional , intent(in) :: n !< The number of elements to translate, by default the lesser | |
| 449 | !! of 3 or all of the integers | |
| 450 | character(len=5*size(a)+1) :: i2s !< The returned underscore delimited string of integers | |
| 451 | ||
| 452 | character(len=8) :: i2s_temp | |
| 453 | integer :: i, n_max | |
| 454 | ||
| 455 | 45 | n_max = 3 |
| 456 | 45 | if (present(n)) n_max = n |
| 457 | ||
| 458 | 45 | i2s = '' |
| 459 | 162 | do i=1,min(size(a), n_max) |
| 460 | 117 | if (a(i) < 0) then |
| 461 | 0 | write (i2s_temp, '(I5.4)') a(i) |
| 462 | else | |
| 463 | 117 | write (i2s_temp, '(I4.4)') a(i) |
| 464 | endif | |
| 465 | 162 | i2s = trim(i2s) //'_'// trim(i2s_temp) |
| 466 | enddo | |
| 467 | 45 | i2s = adjustl(i2s) |
| 468 | 45 | end function ints_to_string |
| 469 | ||
| 470 | ||
| 471 | !> \namespace mom_string_functions | |
| 472 | !! | |
| 473 | !! By Alistair Adcroft and Robert Hallberg, last updated Sept. 2013. | |
| 474 | !! | |
| 475 | !! The functions here perform a set of useful manipulations of | |
| 476 | !! character strings. Although they are a part of MOM6, the do not | |
| 477 | !! require any other MOM software to be useful. | |
| 478 | ||
| 479 | 159 | end module MOM_string_functions |