Line data Source code
1 : !> \file mo_string_utils.f90
2 : !> \brief \copybrief mo_string_utils
3 : !> \details \copydetails mo_string_utils
4 :
5 : !> \brief String utilities
6 : !> \details This module provides string conversion and checking utilities.
7 : !> \authors Matthias Cuntz, Matthias Zink, Giovanni Dalmasso, David Schaefer
8 : !> \date Dec 2011
9 : !> \copyright Copyright 2005-\today, the CHS Developers, Sabine Attinger: All rights reserved.
10 : !! FORCES is released under the LGPLv3+ license \license_note
11 : MODULE mo_string_utils
12 :
13 : USE mo_kind, ONLY: i4, i8, sp, dp
14 :
15 : IMPLICIT NONE
16 :
17 : PUBLIC :: compress ! Conversion : 'A b C x Y z' -> 'AbCxYz'
18 : PUBLIC :: divide_string ! split string in substring with the help of delimiter
19 : PUBLIC :: equalStrings ! compares two strings
20 : PUBLIC :: nonull ! Check if string is still NULL
21 : PUBLIC :: num2str ! Convert a number to a string
22 : PUBLIC :: separator ! Format string: '-----...-----'
23 : PUBLIC :: splitString ! splits string at given delimiter
24 : PUBLIC :: startswith ! checks if string starts with a certain prefix
25 : PUBLIC :: endswith ! checks if string ends with a certain suffix
26 : PUBLIC :: str2num ! Converts string into an array of its numerical representation
27 : PUBLIC :: tolower ! Conversion : 'ABCXYZ' -> 'abcxyz'
28 : PUBLIC :: toupper ! Conversion : 'abcxyz' -> 'ABCXYZ'
29 : PUBLIC :: Replace_Text ! replaces all text occurences in string
30 : PUBLIC :: replace_word ! replaces all word occurences in string
31 : PUBLIC :: index_word ! yields starting position of word in string or 0
32 : PUBLIC :: is_blank
33 :
34 : ! public :: numarray2str
35 :
36 : ! ------------------------------------------------------------------
37 :
38 : !> \brief Convert to string.
39 :
40 : !> \details Convert a number or logical to a string with an optional format.
41 : !!
42 : !! \b Example
43 : !!
44 : !! \code{.f90}
45 : !! str = num2str(3.1415217_i4,'(F3.1)')
46 : !! \endcode
47 : !! See also example in test directory.
48 :
49 : !> \param[in] "integer(i4/i8)/real(sp/dp)/logical :: num" Number or logical
50 : !> \param[in] "character(len=*), optional :: form" Format string\n
51 : !! Defaults are:\n
52 : !! i4 - '(I10)'\n
53 : !! i8 - '(I20)'\n
54 : !! sp/dp - '(G32.5)'\n
55 : !! log - '(L10)'
56 : !> \retval "character(len=X) :: str" String of formatted input number or logical\n
57 : !! Output length X is:\n
58 : !! i4 - 10\n
59 : !! i8 - 20\n
60 : !! sp/dp - 32\n
61 : !! log - 10
62 :
63 : !> \note
64 : !! Uses WRITE to write into string. Recursive write is not permitted before Fortran 2003
65 : !! so that one cannot use\n
66 : !! \code{.f90}
67 : !! write(*,*) 'A='//num2str(a)
68 : !! \endcode
69 : !! Use 'call message' from mo_messages.f90
70 : !! \code{.f90}
71 : !! use mo_messages, only message
72 : !! call message('A=', trim(num2str(a)))
73 : !! \endcode
74 : !! or write into another string first:
75 : !! \code{.f90}
76 : !! str = 'A='//num2str(a)
77 : !! write(*,*) trim(str)
78 : !! \endcode
79 :
80 : !> \author Matthias Cuntz
81 : !> \date Dec 2011
82 : !! - modified from Echam5, (C) MPI-MET, Hamburg, Germany
83 : INTERFACE num2str
84 : MODULE PROCEDURE i42str, i82str, sp2str, dp2str, log2str
85 : END INTERFACE num2str
86 :
87 :
88 : ! ------------------------------------------------------------------
89 :
90 : !> \brief Convert to string.
91 :
92 : !> \details Convert a array of numbers or logicals to a string.
93 : !!
94 : !! \b Example
95 : !!
96 : !! \code{.f90}
97 : !! str = numarray2str(num)
98 : !! \endcode
99 :
100 : !> \param[in] "integer(i4/i8)/real(sp/dp)/logical :: num(:)" Array of numbers or logicals
101 : !> \retval "character(len=X) :: str" String of formatted input number or logical\n
102 :
103 : !> \author Matthias Cuntz
104 : !> \date Dec 2011
105 : !! - modified from Echam5, (C) MPI-MET, Hamburg, Germany
106 : INTERFACE numarray2str
107 : MODULE PROCEDURE i4array2str
108 : END INTERFACE numarray2str
109 :
110 : ! ------------------------------------------------------------------
111 :
112 : PRIVATE
113 :
114 : ! ------------------------------------------------------------------
115 : !> separator string (line)
116 : CHARACTER(len=*), PARAMETER :: separator = repeat('-',70)
117 :
118 : ! ------------------------------------------------------------------
119 :
120 : CONTAINS
121 :
122 : !> \brief Check for blank characters.
123 : !> \details Checks whether or not `c` is a blank character, namely a space and tab character.
124 : !> \return Truth value if `c` is a blank.
125 18 : pure logical function is_blank(c)
126 :
127 : character(len=1), intent(in) :: c !< The character to test.
128 : integer :: ic
129 :
130 18 : ic = iachar(c) ! TAB
131 18 : is_blank = (c == ' ') .or. (ic == int(z'09'));
132 :
133 18 : end function is_blank
134 :
135 : ! ------------------------------------------------------------------
136 :
137 : !> \brief Remove white spaces
138 :
139 : !> \details Return a copy of an input string with all whitespace (spaces and tabs) removed
140 : !!
141 : !! \b Example
142 : !!
143 : !! Returns 'Hallo'
144 : !! \code{.f90}
145 : !! noSpaces = whiteSpaces = compress('H a l l o')
146 : !! \endcode
147 :
148 : !> \param[in] "character(len=*) :: whiteSpaces" String
149 : !> \param[out] "integer(i4), optional :: n" Integer
150 : !> \retval "character(len = len(whiteSpaces)) :: compress" String where all all whitespace (spaces and tabs) are removed
151 :
152 : !> \author Giovanni Dalmasso
153 : !> \date Jan 2013
154 : !! - modified from Paul van Delst, CIMSS/SSEC 18-Oct-1999
155 :
156 34 : function compress( whiteSpaces, n )
157 :
158 18 : use mo_kind, only : i4
159 :
160 : implicit none
161 :
162 : character(len=*), intent(in) :: whiteSpaces
163 : integer(i4), optional, intent(out) :: n
164 :
165 : character(len(whiteSpaces)) :: compress
166 :
167 : ! Local parameters
168 : integer(i4), parameter :: iachar_space = 32_i4
169 : integer(i4), parameter :: iachar_tab = 9_i4
170 :
171 : ! Local variables
172 : integer(i4) :: i, j
173 : integer(i4) :: iachar_character
174 :
175 : ! Setup
176 :
177 : ! Initialise compress
178 34 : compress = ' '
179 : ! Initialise counter
180 : j = 0_i4
181 :
182 : ! Loop over string
183 418 : do i = 1, len(whiteSpaces)
184 : ! Convert the current character to its position
185 384 : iachar_character = iachar(whiteSpaces(i:i))
186 :
187 : ! If the character is NOT a space ' ' or a tab '->|' copy it to the output string.
188 418 : if ( iachar_character /= iachar_space .and. iachar_character /= iachar_tab ) then
189 137 : j = j + 1
190 137 : compress(j:j) = whiteSpaces(i:i)
191 : end if
192 : end do
193 :
194 : ! Save the non-whitespace count
195 34 : if ( present(n) ) n = j
196 :
197 68 : end function compress
198 :
199 : ! replaces text
200 : ! e.g. replace_text('our hour', 'our', 'their') --> 'their htheir'
201 1 : function replace_text (s,text,rep) result(outs)
202 : character(*) :: s,text,rep
203 : character(len(s)+100) :: outs ! provide outs with extra 100 char len
204 : integer :: i, nt, nr
205 :
206 1 : outs = s ; nt = len_trim(text) ; nr = len_trim(rep)
207 1 : if (text == rep) return
208 2 : do
209 3 : i = index(outs,text(:nt)) ; if (i == 0) exit
210 3 : outs = outs(:i-1) // rep(:nr) // outs(i+nt:)
211 : end do
212 35 : end function replace_text
213 :
214 : !> \brief replaces words in a string
215 : !> \details replaces proper words only, e.g. replace_word('our hour', 'our', 'their') --> 'their hour'
216 : !> \author Robert Schweppe
217 : !> \date Nov 2018
218 0 : function replace_word(s, word, rep, check_negative_number_arg) result(outs)
219 : character(*) :: s, word, rep
220 : logical, optional :: check_negative_number_arg
221 : character(len(s)+100) :: outs ! provide outs with extra 100 char len
222 : integer :: i, nt, nr
223 :
224 0 : outs = s ; nt = len_trim(word) ; nr = len_trim(rep)
225 0 : if (word == rep) return
226 0 : do
227 0 : i = index_word(outs, word(:nt), check_negative_number_arg)
228 0 : if (i == 0) exit
229 0 : outs = outs(:i-1) // rep(:nr) // outs(i+nt:)
230 : end do
231 1 : end function replace_word
232 :
233 : !> \brief find index in word
234 : !> \author Robert Schweppe
235 : !> \date Nov 2018
236 0 : function index_word(s, text, check_negative_number_arg) result(out_index)
237 : CHARACTER(*) :: s
238 : CHARACTER(*) :: text
239 : logical, optional :: check_negative_number_arg
240 : integer :: out_index
241 :
242 : integer :: i, nw, ns, i_add
243 : logical :: is_begin_not_word, check_negative_number_default
244 : character(63), parameter :: word_chars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_'
245 : character(10), parameter :: digit_chars = '0123456789'
246 :
247 0 : check_negative_number_default = .false.
248 0 : if (present(check_negative_number_arg)) then
249 0 : check_negative_number_default = check_negative_number_arg
250 : end if
251 :
252 0 : nw = LEN_TRIM(text) ; ns = LEN_TRIM(s)
253 0 : out_index = 0
254 0 : i = 1
255 0 : scan_loop: DO
256 : ! find index of the first character of word in string that has not been scanned so far
257 0 : i_add = scan(s(i:ns), text(1:1))
258 0 : i = i + i_add - 1
259 0 : if (i_add == 0 .or. i+nw-1 > ns) then
260 : ! the word cannot be in string as the first char is not even contained or
261 : ! the word cannot be in string starting at i as it would be too long
262 : exit
263 0 : else if (s(i:i+nw-1) == trim(text)) then
264 : ! charachter matches the word
265 0 : is_begin_not_word = .true.
266 0 : if (i-1 > 0) then
267 : ! is the word preceded by a alphanumeric character?
268 0 : if (scan(s(i-1:i-1), word_chars) == 1) then
269 : is_begin_not_word = .false.
270 : else if (check_negative_number_default .and. &
271 0 : scan(s(i-1:i-1), '-') == 1 .and. &
272 : scan(digit_chars, text(1:1)) > 0 ) then
273 : is_begin_not_word = .false.
274 : end if
275 : end if
276 : if (is_begin_not_word) then
277 : ! is the word succeeded by a alphanumeric character?
278 0 : if (scan(s(i+nw:i+nw), word_chars) == 1) then
279 : ! word boundary end is violated, continue
280 : i = i + 1
281 : else
282 : ! index is found and word boundaries are checked
283 0 : out_index = i
284 0 : exit scan_loop
285 : end if
286 : else
287 : ! word boundary start is violated, continue
288 : i = i + 1
289 : end if
290 : else
291 : ! word does not match, continue
292 : i = i + 1
293 : end if
294 : END DO scan_loop
295 :
296 0 : end function index_word
297 :
298 : ! ------------------------------------------------------------------
299 :
300 : !> \brief Divide string in substrings.
301 :
302 : !> \details Divides a string in several substrings (array of strings) with the help of a user
303 : !! specified delimiter.
304 : !!
305 : !! \b Example
306 : !!
307 : !! Divide string into 'I', 'want', 'to', ...
308 : !! \code{.f90}
309 : !! divide_string('I want to test this routine!', ' ', strArr(:))
310 : !! \endcode
311 :
312 : !> \param[in] "CHARACTER(len=*), INTENT(IN) :: string" - string to be divided
313 : !> \param[in] "CHARACTER(len=*), INTENT(IN) :: delim" - delimiter specifying places for division
314 : !> \param[out] "CHARACTER(len=*), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: strArr"
315 : !! Array of substrings, has to be allocateable and is handed to the routine unallocated
316 :
317 : !> \note
318 : !! only character types allowed.\n
319 : !! output array should be allocateable array, which is unallocated handed to the subroutine.
320 : !! allocation is done in in devide_string.
321 :
322 : !> \author Matthias Zink
323 : !> \date Oct 2012
324 :
325 23 : SUBROUTINE divide_string(string, delim, strArr)
326 :
327 : IMPLICIT NONE
328 :
329 : CHARACTER(len=*) , INTENT(IN) :: string
330 : CHARACTER(len=*) , INTENT(IN) :: delim
331 : CHARACTER(len=*), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: strArr
332 :
333 : CHARACTER(256) :: stringDummy ! string in fisrt place but cutted in pieces
334 23 : CHARACTER(256), DIMENSION(:) , ALLOCATABLE :: strDummyArr ! Dummy arr until number of substrings is known
335 : INTEGER(i4) :: pos ! position of dilimiter
336 : INTEGER(i4) :: nosubstr ! number of substrings in string
337 :
338 23 : stringDummy = string
339 :
340 69 : allocate(strDummyArr(len_trim(stringDummy)))
341 23 : pos=999_i4
342 23 : nosubstr=0_i4
343 : ! search for substrings and theirs count
344 : do
345 78 : pos = index(trim(adjustl(stringDummy)), delim)
346 : ! exit if no more delimiter is find and save the last part of the string
347 78 : if (pos == 0_i4) then
348 23 : nosubstr = nosubstr + 1_i4
349 23 : StrDummyArr(nosubstr) = trim(stringDummy)
350 : exit
351 : end if
352 :
353 55 : nosubstr = nosubstr + 1_i4
354 55 : strDummyArr(nosubstr) = stringDummy(1:pos-1)
355 55 : stringDummy = stringDummy(pos+1:len_trim(stringDummy))
356 : end do
357 : ! hand over results to strArr
358 23 : if (nosubstr == 0_i4) then
359 0 : print*, '***WARNING: string does not contain delimiter. There are no substrings. (subroutine DIVIDE_STRING)'
360 0 : return
361 : else
362 69 : allocate(strArr(nosubstr))
363 124 : strArr = StrDummyArr(1:nosubstr)
364 : end if
365 :
366 23 : deallocate(strDummyArr)
367 :
368 23 : END SUBROUTINE divide_string
369 :
370 : ! ------------------------------------------------------------------
371 :
372 : !> \brief Checks if two string are equal
373 :
374 : !> \details Returns true if the given string arguments are equal
375 : !!
376 : !! \b Example
377 : !!
378 : !! \code{.f90}
379 : !! isequal = equalString(string1,string2)
380 : !! \endcode
381 :
382 : !> \param[in] "character(len=*) :: string1" String
383 : !> \param[in] "character(len=*) :: string2" String
384 : !> \retval "logical :: eq" Logical value if string equal
385 :
386 : !> \author David Schaefer
387 : !> \date Mar 2015
388 :
389 4 : function equalStrings(string1,string2)
390 : implicit none
391 :
392 : character(len=*), intent(in) :: string1, string2
393 4 : integer(i4), allocatable :: array1(:), array2(:)
394 : integer(i4) :: i
395 : logical :: equalStrings
396 :
397 30 : array1 = str2num(trim(string1))
398 29 : array2 = str2num(trim(string2))
399 4 : equalStrings = .false.
400 :
401 4 : if (size(array1) == size(array2)) then
402 17 : equalStrings = .true.
403 17 : do i=1, size(array1)
404 17 : if (array1(i) /= array2(i)) then
405 : equalStrings = .false.
406 : exit
407 : end if
408 : end do
409 : end if
410 :
411 23 : end function equalStrings
412 :
413 : ! ------------------------------------------------------------------
414 :
415 : !> \brief Checks if string was already used
416 :
417 : !> \details Checks if string was already used, i.e. does not contain NULL character anymore.
418 : !!
419 : !! \b Example
420 : !!
421 : !! Trim if string is used.
422 : !! \code{.f90}
423 : !! if (nonull(str)) write(*,*) trim(str)
424 : !! \endcode
425 :
426 : !> \param[in] "character(len=*) :: str" String
427 : !> \retval "logical :: used" .true.: string was already set; .false.: string still in initialised state
428 :
429 : !> \author Matthias Cuntz
430 : !> \date Jan 2012
431 :
432 2 : FUNCTION nonull(str)
433 :
434 : IMPLICIT NONE
435 :
436 : CHARACTER(LEN=*), INTENT(in) :: str
437 : LOGICAL :: nonull
438 :
439 2 : if (scan(str, achar(0)) == 0) then
440 : nonull = .true.
441 : else
442 1 : nonull = .false.
443 : end if
444 :
445 4 : END FUNCTION nonull
446 :
447 : ! ------------------------------------------------------------------
448 :
449 : !> \brief split string at delimiter
450 :
451 : !> \details Split string at delimiter an return an array of strings
452 : !!
453 : !! \b Example
454 : !!
455 : !! \code{.f90}
456 : !! string_parts = splitString(string,delim)
457 : !! \endcode
458 :
459 : !> \param[in] "character(len=*) :: string" String
460 : !> \param[in] "character(len=*) :: delim" String
461 : !> \retval "character(len=245) :: out(:)" Array of splitted strings
462 :
463 : !> \author David Schaefer
464 : !> \date Mar 2015
465 :
466 4 : function splitString(string,delim) result(out)
467 :
468 2 : use mo_append, only : append
469 : implicit none
470 :
471 : character(len=*), intent(in) :: string
472 : character(len=*), intent(in) :: delim
473 : character(len=256), allocatable :: out(:)
474 4 : integer(i4), allocatable :: string_array(:), delim_array(:)
475 : integer(i4) :: i, start
476 : !
477 0 : if (allocated(out)) deallocate(out)
478 143 : string_array = str2num(string//delim)
479 9 : delim_array = str2num(delim)
480 4 : start = 1
481 :
482 142 : do i=1, size(string_array) - size(delim_array) + 1
483 167 : if (all(string_array(i:i+size(delim_array)-1) == delim_array)) then
484 20 : call append(out, numarray2str(string_array(start:i-1)))
485 20 : start = i + size(delim_array)
486 : end if
487 : end do
488 : !
489 4 : end function splitString
490 :
491 : ! ------------------------------------------------------------------
492 :
493 : !> \brief Checks if string starts with character(s)
494 : !> \details Returns true if string starts with given characters, flase otherwise
495 : !> \author David Schaefer
496 : !> \date Mar 2015
497 116 : logical function startswith(string, start, strip)
498 :
499 : implicit none
500 :
501 : character(len=*), intent(in) :: string !< string to check
502 : character(len=*), intent(in) :: start !< starting string
503 : logical, optional, intent(in) :: strip !< whether to strip trailing white-spaces (.false. by default)
504 :
505 : integer(i4) :: i
506 : logical :: strip_
507 :
508 116 : strip_ = .false.
509 116 : if ( present(strip) ) strip_ = strip
510 :
511 0 : if (strip_) then
512 0 : i = index(trim(string), trim(start))
513 : else
514 116 : i = index(string, start)
515 : end if
516 :
517 116 : startswith = i == 1
518 :
519 4 : end function startswith
520 :
521 : ! ------------------------------------------------------------------
522 :
523 : !> \brief Checks if (maybe trimmed) string ends with given character(s)
524 : !> \retval "endswith" if string ends with given end
525 : !> \author Sebastian Müller
526 : !> \date Mar 2023
527 95 : logical function endswith(string, suffix, strip)
528 :
529 : implicit none
530 :
531 : character(len=*), intent(in) :: string !< string to check
532 : character(len=*), intent(in) :: suffix !< ending string
533 : logical, optional, intent(in) :: strip !< whether to strip trailing white-spaces (.true. by default)
534 :
535 : integer(i4) :: i, ref
536 : logical :: strip_
537 :
538 95 : strip_ = .true.
539 95 : if ( present(strip) ) strip_ = strip
540 :
541 0 : if (strip_) then
542 95 : i = index(trim(string), trim(suffix), back=.true.)
543 95 : ref = len_trim(string) - len_trim(suffix) + 1_i4
544 : else
545 0 : i = index(string, suffix, back=.true.)
546 0 : ref = len(string) - len(suffix) + 1_i4
547 : end if
548 :
549 95 : endswith = i == ref
550 :
551 116 : end function endswith
552 :
553 : ! ------------------------------------------------------------------
554 :
555 : !> \brief Convert to lower case
556 :
557 : !> \details Convert all upper case letters in string to lower case letters.
558 : !!
559 : !! \b Example
560 : !!
561 : !! Returns 'hallo'
562 : !! \code{.f90}
563 : !! low = tolower('Hallo')
564 : !! \endcode
565 :
566 : !> \param[in] "character(len=*) :: upper" String
567 : !> \retval "character(len=len_trim(upper)) :: low" String where all uppercase in input is converted to lowercase
568 :
569 : !> \author Matthias Cuntz
570 : !> \date Dec 2011
571 : !! - modified from Echam5, (C) MPI-MET, Hamburg, Germany
572 :
573 28 : FUNCTION tolower(upper)
574 :
575 : IMPLICIT NONE
576 :
577 : CHARACTER(LEN=*) ,INTENT(in) :: upper
578 : CHARACTER(LEN=LEN_TRIM(upper)) :: tolower
579 :
580 : INTEGER :: i
581 : INTEGER ,PARAMETER :: idel = ICHAR('a')-ICHAR('A')
582 :
583 102 : DO i=1,LEN_TRIM(upper)
584 74 : IF (ICHAR(upper(i:i)) >= ICHAR('A') .AND. &
585 28 : ICHAR(upper(i:i)) <= ICHAR('Z')) THEN
586 1 : tolower(i:i) = CHAR( ICHAR(upper(i:i)) + idel )
587 : ELSE
588 73 : tolower(i:i) = upper(i:i)
589 : END IF
590 : END DO
591 :
592 95 : END FUNCTION tolower
593 :
594 : ! ------------------------------------------------------------------
595 :
596 : !> \brief Convert to upper case
597 :
598 : !> \details Convert all lower case letters in string to upper case letters.
599 : !!
600 : !! \b Example
601 : !!
602 : !! Returns 'HALLO'
603 : !! \code{.f90}
604 : !! up = toupper('Hallo')
605 : !! \endcode
606 :
607 : !> \param[in] "character(len=*) :: lower" String
608 : !> \retval "character(len=len_trim(lower)) :: up" String where all lowercase in input is converted to uppercase
609 :
610 : !> \author Matthias Cuntz
611 : !> \date Dec 2011
612 : !! - modified from Echam5, (C) MPI-MET, Hamburg, Germany
613 :
614 41 : FUNCTION toupper (lower)
615 :
616 : IMPLICIT NONE
617 :
618 : CHARACTER(LEN=*) ,INTENT(in) :: lower
619 : CHARACTER(LEN=LEN_TRIM(lower)) :: toupper
620 :
621 : INTEGER :: i
622 : INTEGER, PARAMETER :: idel = ICHAR('A')-ICHAR('a')
623 :
624 798 : DO i=1,LEN_TRIM(lower)
625 757 : IF (ICHAR(lower(i:i)) >= ICHAR('a') .AND. &
626 41 : ICHAR(lower(i:i)) <= ICHAR('z')) THEN
627 4 : toupper(i:i) = CHAR( ICHAR(lower(i:i)) + idel )
628 : ELSE
629 753 : toupper(i:i) = lower(i:i)
630 : END IF
631 : END DO
632 :
633 28 : END FUNCTION toupper
634 :
635 :
636 : ! -----------------------------------------------------------
637 : ! PRIVATE ROUTINES
638 : ! (no "template" documentation required)
639 : ! -----------------------------------------------------------
640 :
641 34 : PURE FUNCTION i42str(nn,form)
642 : ! returns integer nn as a string (often needed in printing messages)
643 : IMPLICIT NONE
644 : INTEGER(i4), INTENT(IN) :: nn
645 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: form
646 : CHARACTER(len=10) :: i42str
647 :
648 34 : if (present(form)) then
649 34 : write(i42str,form) nn
650 : else
651 0 : write(i42str,'(I10)') nn
652 : end if
653 : !i42str = adjustl(i42str)
654 :
655 41 : END FUNCTION i42str
656 :
657 :
658 1 : PURE FUNCTION i82str(nn,form)
659 : ! returns integer nn as a string (often needed in printing messages)
660 : IMPLICIT NONE
661 : INTEGER(i8), INTENT(IN) :: nn
662 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: form
663 : CHARACTER(len=20) :: i82str
664 :
665 1 : if (present(form)) then
666 1 : write(i82str,form) nn
667 : else
668 0 : write(i82str,'(I20)') nn
669 : end if
670 : !i82str = adjustl(i82str)
671 :
672 34 : END FUNCTION i82str
673 :
674 :
675 1 : PURE FUNCTION sp2str(rr,form)
676 : ! returns real rr as a string (often needed in printing messages)
677 : IMPLICIT NONE
678 : REAL(sp), INTENT(IN) :: rr
679 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: form
680 : CHARACTER(len=32) :: sp2str
681 :
682 1 : if (present(form)) then
683 1 : write(sp2str,form) rr
684 : else
685 0 : write(sp2str,'(G32.5)') rr
686 : end if
687 : !sp2str = adjustl(sp2str)
688 :
689 1 : END FUNCTION sp2str
690 :
691 :
692 1 : PURE FUNCTION dp2str(rr,form)
693 : ! returns real rr as a string (often needed in printing messages)
694 : IMPLICIT NONE
695 : REAL(dp), INTENT(IN) :: rr
696 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: form
697 : CHARACTER(len=32) :: dp2str
698 :
699 1 : if (present(form)) then
700 1 : write(dp2str,form) rr
701 : else
702 0 : write(dp2str,'(G32.5)') rr
703 : end if
704 : !dp2str = adjustl(dp2str)
705 :
706 1 : END FUNCTION dp2str
707 :
708 :
709 1 : PURE FUNCTION log2str(ll,form)
710 : ! returns logical ll as a string (often needed in printing messages)
711 : IMPLICIT NONE
712 : LOGICAL, INTENT(in) :: ll
713 : CHARACTER(len=*), INTENT(IN), OPTIONAL :: form
714 : CHARACTER(len=10) :: log2str
715 :
716 1 : if (present(form)) then
717 1 : write(log2str,form) ll
718 : else
719 0 : write(log2str,'(L10)') ll
720 : end if
721 : !log2str = adjustl(log2str)
722 :
723 1 : END FUNCTION log2str
724 :
725 20 : function i4array2str(arr) result(out)
726 :
727 : integer(i4), intent(in) :: arr(:)
728 : integer(i4) :: ii
729 : character(len=size(arr)) :: out
730 :
731 20 : out = " "
732 135 : do ii=1,size(arr)
733 135 : out(ii:ii) = char(arr(ii))
734 : end do
735 :
736 1 : end function i4array2str
737 :
738 : ! ------------------------------------------------------------------
739 :
740 : !> \brief Converts string into an array of its numerical representation
741 :
742 : !> \details Converts string into an integer array of the numerical values of the letters
743 : !!
744 : !! \b Example
745 : !!
746 : !! Convert is string into numerical array of the letters
747 : !! \code{.f90}
748 : !! num = str2num(string)
749 : !! \endcode
750 :
751 : !> \param[in] "character(len=*) :: string" String
752 : !> \retval "integer :: out(:)" Numerical array of letters
753 :
754 : !> \author David Schaefer
755 : !> \date Mar 2015
756 :
757 16 : function str2num(string) result(out)
758 :
759 : implicit none
760 :
761 : character(len=*), intent(in) :: string
762 : integer(i4), allocatable :: out(:)
763 : integer(i4) :: i
764 :
765 16 : if (allocated(out)) deallocate(out)
766 48 : allocate(out(len(string)))
767 :
768 211 : do i=1,len(string)
769 211 : out(i) = ichar(string(i:i))
770 : end do
771 :
772 20 : end function str2num
773 :
774 :
775 : END MODULE mo_string_utils
|
