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