Line data Source code
1 : module string_utils
2 :
3 : ! Miscellaneous string utilities.
4 :
5 : use cam_abortutils, only: endrun
6 : use cam_logfile, only: iulog
7 :
8 : implicit none
9 : private
10 :
11 : ! Public interface methods
12 :
13 : public ::&
14 : to_upper, & ! Convert character string to upper case
15 : to_lower, & ! Convert character string to lower case
16 : INCSTR, & ! increments a string
17 : GLC, & ! Position of last significant character in string
18 : strlist_get_ind, & ! find string in a list of strings and return its index
19 : date2yyyymmdd, & ! convert encoded date integer to "yyyy-mm-dd" format
20 : sec2hms, & ! convert integer seconds past midnight to "hh:mm:ss" format
21 : int2str ! convert integer to left justified string
22 :
23 : contains
24 :
25 65003184 : function to_upper(str)
26 :
27 : !-----------------------------------------------------------------------
28 : ! Purpose:
29 : ! Convert character string to upper case.
30 : !
31 : ! Method:
32 : ! Use achar and iachar intrinsics to ensure use of ascii collating sequence.
33 : !
34 : !-----------------------------------------------------------------------
35 : implicit none
36 :
37 : character(len=*), intent(in) :: str ! String to convert to upper case
38 : character(len=len(str)) :: to_upper
39 :
40 : ! Local variables
41 :
42 : integer :: i ! Index
43 : integer :: aseq ! ascii collating sequence
44 : integer :: lower_to_upper ! integer to convert case
45 : character(len=1) :: ctmp ! Character temporary
46 : !-----------------------------------------------------------------------
47 65003184 : lower_to_upper = iachar("A") - iachar("a")
48 :
49 584904240 : do i = 1, len(str)
50 519901056 : ctmp = str(i:i)
51 519901056 : aseq = iachar(ctmp)
52 519901056 : if ( aseq >= iachar("a") .and. aseq <= iachar("z") ) &
53 0 : ctmp = achar(aseq + lower_to_upper)
54 584904240 : to_upper(i:i) = ctmp
55 : end do
56 :
57 65003184 : end function to_upper
58 :
59 57133584 : function to_lower(str)
60 :
61 : !-----------------------------------------------------------------------
62 : ! Purpose:
63 : ! Convert character string to lower case.
64 : !
65 : ! Method:
66 : ! Use achar and iachar intrinsics to ensure use of ascii collating sequence.
67 : !
68 : !-----------------------------------------------------------------------
69 : implicit none
70 :
71 : character(len=*), intent(in) :: str ! String to convert to lower case
72 : character(len=len(str)) :: to_lower
73 :
74 : ! Local variables
75 :
76 : integer :: i ! Index
77 : integer :: aseq ! ascii collating sequence
78 : integer :: upper_to_lower ! integer to convert case
79 : character(len=1) :: ctmp ! Character temporary
80 : !-----------------------------------------------------------------------
81 57133584 : upper_to_lower = iachar("a") - iachar("A")
82 :
83 949575432 : do i = 1, len(str)
84 892441848 : ctmp = str(i:i)
85 892441848 : aseq = iachar(ctmp)
86 892441848 : if ( aseq >= iachar("A") .and. aseq <= iachar("Z") ) &
87 24576 : ctmp = achar(aseq + upper_to_lower)
88 949575432 : to_lower(i:i) = ctmp
89 : end do
90 :
91 57133584 : end function to_lower
92 :
93 0 : integer function INCSTR( s, inc )
94 : !-----------------------------------------------------------------------
95 : ! ... Increment a string whose ending characters are digits.
96 : ! The incremented integer must be in the range [0 - (10**n)-1]
97 : ! where n is the number of trailing digits.
98 : ! Return values:
99 : !
100 : ! 0 success
101 : ! -1 error: no trailing digits in string
102 : ! -2 error: incremented integer is out of range
103 : !-----------------------------------------------------------------------
104 :
105 : implicit none
106 :
107 : !-----------------------------------------------------------------------
108 : ! ... Dummy variables
109 : !-----------------------------------------------------------------------
110 : integer, intent(in) :: &
111 : inc ! value to increment string (may be negative)
112 : character(len=*), intent(inout) :: &
113 : s ! string with trailing digits
114 :
115 :
116 : !-----------------------------------------------------------------------
117 : ! ... Local variables
118 : !-----------------------------------------------------------------------
119 : integer :: &
120 : i, & ! index
121 : lstr, & ! number of significant characters in string
122 : lnd, & ! position of last non-digit
123 : ndigit, & ! number of trailing digits
124 : ival, & ! integer value of trailing digits
125 : pow, & ! power of ten
126 : digit ! integer value of a single digit
127 :
128 0 : lstr = GLC( s )
129 0 : lnd = LASTND( s )
130 0 : ndigit = lstr - lnd
131 :
132 0 : if( ndigit == 0 ) then
133 : INCSTR = -1
134 : return
135 : end if
136 :
137 : !-----------------------------------------------------------------------
138 : ! ... Calculate integer corresponding to trailing digits.
139 : !-----------------------------------------------------------------------
140 : ival = 0
141 : pow = 0
142 0 : do i = lstr,lnd+1,-1
143 0 : digit = ICHAR(s(i:i)) - ICHAR('0')
144 0 : ival = ival + digit * 10**pow
145 0 : pow = pow + 1
146 : end do
147 :
148 : !-----------------------------------------------------------------------
149 : ! ... Increment the integer
150 : !-----------------------------------------------------------------------
151 0 : ival = ival + inc
152 0 : if( ival < 0 .or. ival > 10**ndigit-1 ) then
153 : INCSTR = -2
154 : return
155 : end if
156 :
157 : !-----------------------------------------------------------------------
158 : ! ... Overwrite trailing digits
159 : !-----------------------------------------------------------------------
160 0 : pow = ndigit
161 0 : do i = lnd+1,lstr
162 0 : digit = MOD( ival,10**pow ) / 10**(pow-1)
163 0 : s(i:i) = CHAR( ICHAR('0') + digit )
164 0 : pow = pow - 1
165 : end do
166 :
167 : INCSTR = 0
168 :
169 : end function INCSTR
170 :
171 0 : integer function LASTND( cs )
172 : !-----------------------------------------------------------------------
173 : ! ... Position of last non-digit in the first input token.
174 : ! Return values:
175 : ! > 0 => position of last non-digit
176 : ! = 0 => token is all digits (or empty)
177 : !-----------------------------------------------------------------------
178 :
179 : implicit none
180 :
181 : !-----------------------------------------------------------------------
182 : ! ... Dummy arguments
183 : !-----------------------------------------------------------------------
184 : character(len=*), intent(in) :: cs ! Input character string
185 :
186 : !-----------------------------------------------------------------------
187 : ! ... Local variables
188 : !-----------------------------------------------------------------------
189 : integer :: n, nn, digit
190 :
191 0 : n = GLC( cs )
192 0 : if( n == 0 ) then ! empty string
193 : LASTND = 0
194 : return
195 : end if
196 :
197 0 : do nn = n,1,-1
198 0 : digit = ICHAR( cs(nn:nn) ) - ICHAR('0')
199 0 : if( digit < 0 .or. digit > 9 ) then
200 : LASTND = nn
201 : return
202 : end if
203 : end do
204 :
205 : LASTND = 0 ! all characters are digits
206 :
207 : end function LASTND
208 :
209 55513800 : integer function GLC( cs )
210 : !-----------------------------------------------------------------------
211 : ! ... Position of last significant character in string.
212 : ! Here significant means non-blank or non-null.
213 : ! Return values:
214 : ! > 0 => position of last significant character
215 : ! = 0 => no significant characters in string
216 : !-----------------------------------------------------------------------
217 :
218 : implicit none
219 :
220 : !-----------------------------------------------------------------------
221 : ! ... Dummy arguments
222 : !-----------------------------------------------------------------------
223 : character(len=*), intent(in) :: cs ! Input character string
224 :
225 : !-----------------------------------------------------------------------
226 : ! ... Local variables
227 : !-----------------------------------------------------------------------
228 : integer :: l, n
229 :
230 55513800 : l = LEN( cs )
231 55513800 : if( l == 0 ) then
232 : GLC = 0
233 : return
234 : end if
235 :
236 950491080 : do n = l,1,-1
237 950491080 : if( cs(n:n) /= ' ' .and. cs(n:n) /= CHAR(0) ) then
238 : exit
239 : end if
240 : end do
241 : GLC = n
242 :
243 : end function GLC
244 :
245 : !=========================================================================================
246 :
247 0 : subroutine strlist_get_ind(strlist, str, ind, abort)
248 :
249 : ! Get the index of a given string in a list of strings. Optional abort argument
250 : ! allows returning control to caller when the string is not found. Default
251 : ! behavior is to call endrun when string is not found.
252 :
253 : ! Arguments
254 : character(len=*), intent(in) :: strlist(:) ! list of strings
255 : character(len=*), intent(in) :: str ! string to search for
256 : integer, intent(out) :: ind ! index of str in strlist
257 : logical, optional, intent(in) :: abort ! flag controlling abort
258 :
259 : ! Local variables
260 : integer :: m
261 : logical :: abort_on_error
262 : character(len=*), parameter :: sub='strlist_get_ind'
263 : !----------------------------------------------------------------------------
264 :
265 : ! Find string in list
266 0 : do m = 1, size(strlist)
267 0 : if (str == strlist(m)) then
268 0 : ind = m
269 0 : return
270 : end if
271 : end do
272 :
273 : ! String not found
274 0 : abort_on_error = .true.
275 0 : if (present(abort)) abort_on_error = abort
276 :
277 0 : if (abort_on_error) then
278 0 : write(iulog, *) sub//': FATAL: string:', trim(str), ' not found in list:', strlist(:)
279 0 : call endrun(sub//': FATAL: string not found')
280 : end if
281 :
282 : ! error return
283 0 : ind = -1
284 :
285 : end subroutine strlist_get_ind
286 :
287 : !=========================================================================================
288 :
289 491520 : character(len=10) function date2yyyymmdd (date)
290 :
291 : ! Input arguments
292 :
293 : integer, intent(in) :: date
294 :
295 : ! Local workspace
296 :
297 : integer :: year ! year of yyyy-mm-dd
298 : integer :: month ! month of yyyy-mm-dd
299 : integer :: day ! day of yyyy-mm-dd
300 :
301 491520 : if (date < 0) then
302 0 : call endrun ('DATE2YYYYMMDD: negative date not allowed')
303 : end if
304 :
305 491520 : year = date / 10000
306 491520 : month = (date - year*10000) / 100
307 491520 : day = date - year*10000 - month*100
308 :
309 491520 : write(date2yyyymmdd,80) year, month, day
310 : 80 format(i4.4,'-',i2.2,'-',i2.2)
311 :
312 491520 : end function date2yyyymmdd
313 :
314 : !=========================================================================================
315 :
316 491520 : character(len=8) function sec2hms (seconds)
317 :
318 : ! Input arguments
319 :
320 : integer, intent(in) :: seconds
321 :
322 : ! Local workspace
323 :
324 : integer :: hours ! hours of hh:mm:ss
325 : integer :: minutes ! minutes of hh:mm:ss
326 : integer :: secs ! seconds of hh:mm:ss
327 :
328 491520 : if (seconds < 0 .or. seconds > 86400) then
329 0 : write(iulog,*)'SEC2HMS: bad input seconds:', seconds
330 0 : call endrun ('SEC2HMS: bad input seconds:')
331 : end if
332 :
333 491520 : hours = seconds / 3600
334 491520 : minutes = (seconds - hours*3600) / 60
335 491520 : secs = (seconds - hours*3600 - minutes*60)
336 :
337 491520 : write(sec2hms,80) hours, minutes, secs
338 : 80 format(i2.2,':',i2.2,':',i2.2)
339 :
340 491520 : end function sec2hms
341 :
342 : !=========================================================================================
343 :
344 6144 : character(len=10) function int2str(n)
345 :
346 : ! return default integer as a left justified string
347 :
348 : ! arguments
349 : integer, intent(in) :: n
350 : !----------------------------------------------------------------------------
351 :
352 6144 : write(int2str,'(i0)') n
353 :
354 6144 : end function int2str
355 :
356 : !=========================================================================================
357 :
358 : end module string_utils
|
